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