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

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