1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

Vb help !!!!!!!!!!!!!!!!

Discussion in 'Visual Basic ( VB )' started by Teaser, Sep 20, 2010.

  1. Teaser

    Teaser New Member

    Joined:
    Sep 20, 2010
    Messages:
    1
    Likes Received:
    0
    Trophy Points:
    0
    Hi Guys,

    I have two sets of code. The first one basically looks in a folder, identifies the xls files and loads the data into a database tbl. The 2nd is basically an email script. What I am trying to do is add error handling to the 1st code so that it works as such : if a file fails to load then send out this email.

    both codes are below. Thanks for any assistance you can offer.


    Code:
    Function Main()
    
    Const adOpenForwardOnly = 0 
    Const adLockReadOnly = 1 
    Const adCmdText = &H0001 
    
    dim strSqlConnection 
    dim dbSqlConnect
    dim strSQL 
    dim objSqlCmd
    dim dbXlConnect 
    dim strXlSQL
    dim rstXlResults
    dim arrXlData
    dim objFSO 
    dim objStartFolder 
    dim objFolder 
    dim objFile
    
    objStartFolder = "F:\Metastorm BPM\MDS\Output\" strXlSQL = "SELECT * FROM [Sheet1$A3:T65000]" Set strSqlConnection = CreateObject("ADODB.Connection") strSqlConnection.Provider = "sqloledb" strSqlConnection.Properties("Data Source").Value = "gbr00wrkd1" strSqlConnection.Properties("Initial Catalog").Value = "e-work" strSqlConnection.Properties("User ID").Value = "ework" strSqlConnection.Properties("Password").Value = "cq" 
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    If Not objFSO.FolderExists(objStartFolder) Then ' Does folder exist? 
    
    Else
    Set objFolder = objFSO.GetFolder(objStartFolder)
    
    For each objFile In objFolder.Files ' Begin to LOOP through all files in the specified folder and process
    
    If objFSO.GetExtensionName(objFile) = "xls" Then
    
    Set dbXlConnect = CreateObject("ADODB.Connection") 
    
    dbXlConnect.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & objFile.Path & ";Extended Properties=""Excel 8.0;HDR=Yes;"";" ' Excel Object connection properties
    
    Set rstXlResults = CreateObject("ADODB.Recordset") rstXlResults.Open strXlSQL, dbXlConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    if rstXlResults.bof and rstXlResults.eof then ' Begin to create recordset
    
    else
    
    arrXlData = rstXlResults.GetRows end if
    
    rstXlResults.Close
    
    Set rstXlResults = Nothing
    
    dbXlConnect.Close
    
    Set dbXlConnect = Nothing
    
    if isarray(arrXlData) then Set dbSqlConnect = CreateObject("ADODB.Connection")
    dbSqlConnect.Open strSqlConnection
    
    for x=0 to ubound(arrXlData,2) strSQL = "INSERT INTO dbo.MDS_TEMP_Staging VALUES ('" & arrXlData(0,x) & "','" & arrXlData(1,x) & "','" & arrXlData(2,x) & "', '" & arrXlData(3,x) & "','" & arrXlData(4,x) & "', '" & arrXlData(5,x) & "','" & arrXlData(6,x) & "' , '" & arrXlData(7,x) & "','" & arrXlData(8,x) & "','" & arrXlData(9,x) & "', '" & arrXlData(10,x) & "','" & arrXlData(11,x) & "', '" & arrXlData(12,x) & "','" & arrXlData(13,x) & "' ,'" & arrXlData(14,x) & "','" & arrXlData(15,x) & "','" & arrXlData(16,x) & "', '" & arrXlData(17,x) & "', '" & arrXlData(18,x) & "', '" & arrXlData(19,x) & "')"
    
    Set objSqlCmd = CreateObject("ADODB.Command")
    objSqlCmd.ActiveConnection = dbSqlConnect
    objSqlCmd.CommandType = adCmdText
    objSqlCmd.CommandText = strSQL
    
    objSqlCmd.Execute
    Set objSqlCmd = Nothing
    
    next
    
    set dbSqlConnect = nothing
    set arrXlData = nothing
    
    end if
    
    End If
    Next
    
    End If
    
    set objFSO = Nothing
    
    Main = DTSTaskExecResult_Success
    
    End Function

    AND THE EMAIL CODE IS :

    Code:
    '************************************************* *********************
    ' Visual Basic ActiveX Script
    '************************************************* ***********************
    Function Main()
    
    Set conLocal = CreateObject("ADODB.Connection")
    
    conLocal.Provider = "sqloledb"
    conLocal.Properties("Data Source").Value = "gbr00wrkd1"
    conLocal.Properties("Initial Catalog").Value = "e-work"
    conLocal.Properties("Integrated Security").Value = "SSPI"
    conLocal.ConnectionTimeout = 5
    conLocal.commandtimeout = 5
    
    conLocal.Open
    
    dim html_email
    
    strRecipients = "XXXX"
    
    'strCC = "XX"
    
    Call sendEmail(strRecipients, strCC, html_email)
    
    Main = DTSTaskExecResult_Success
    
    End Function
    
    
    Function sendEmail(strRecipients, strCC, html_email)
    
    Dim iMsg
    
    'Use COM to create Message and Configuration Objects
    Set iMsg = CreateObject("CDO.Message")
    
    ' Apply the settings to the message.
    With iMsg
    .To = strRecipients
    If Not IsNull(strCC) Then .CC = strCC
    .From = "XX"
    .Subject = "MONTHLY load has failed"
    .HTMLBody = html_email
    
    .Send
    End With
    
    ' Clean up variables.
    Set iMsg = Nothing
    
    End Function
     
    Last edited by a moderator: Sep 20, 2010

Share This Page