VB ERROR HANDLING

[Teaser]

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.

 

 

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 = "mmm" strSqlConnection.Properties("Data Source").Value = "mmm" strSqlConnection.Properties("Initial Catalog").Value = "mmm" strSqlConnection.Properties("User ID").Value = "mmm" strSqlConnection.Properties("Password").Value = "mmm"

 

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 :

 

'************************************************* *********************

' Visual Basic ActiveX Script

'************************************************* ***********************

Function Main()

 

Set conLocal = CreateObject("ADODB.Connection")

 

conLocal.Provider = "sqloledb"

conLocal.Properties("Data Source").Value = "

conLocal.Properties("Initial Catalog").Value = "

conLocal.Properties("Integrated Security").Value =

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

Edited September 23, 2010 by Teaser

[Teaser]

forgot to say, individually they work fine. Am just trying to integrate them.

[LosOjos]

http://msdn.microsoft.com/en-us/library/s6da8809%28VS.80%29.aspx

[LosOjos]

By the way, unless you want your SQL DB hacking, I'd edit your post and remove the username and password as quickly as you can...

[LosOjos]

And I notice you're using a couple of double negative 'IF' statements, like 'IF Not Folder.Exists'... not a huge problem but it'll make for easier debugging if you change it to say 'If Folder.Exists', you can then get rid of the redundant 'Else' statements

[Teaser]

Thanks LosOjos. I have amended the post

 

I've had a look at the link you provided and am even more lost. Took me forever to write the code above and now this... am loosing my marbles as we speak

[neodong]

im newbie programmer..

 

im usuall use On Error Goto Wrong ' wrong is label under your code

 

example:

dim a as Byte

Dim b as Byte

a=4

b="c"

Exit Sub

Wrong:'<--label

Msgbox"Error Code : " & Err.Description, Err.number

[srochford]

I think you're using VBScript (not VB???) and the error handling is very limited.

 

What you basically do is include an "on error resume next" statement at the beginning, clear the error value before you do "stuff" and then check after each action to see if the error value is non-zero (which means the previous action failed).

 

For example,

on error resume next
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") 
err.clear
dbXlConnect.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & objFile.Path & ";Extended Properties=""Excel 8.0;HDR=Yes;"";" ' Excel Object connection properties
if err.number<>0 then 'an error has occurred
 sendemail "Couldn't open file " & objfile.path
else 
 err.clear
 Set rstXlResults = CreateObject("ADODB.Recordset") rstXlResults.Open strXlSQL, dbXlConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
 if err.number<> 0 then 'an error has occurred
   sendemail "couldn't load data for " & objfile.path
 else 
'etc

end if
end if

 

- first, try to connect to the spreadsheet. Did it work? Yes - carry on; no - send an email.

- second, try to create the recordset. Did it work? Yes, carry on; no - send an email.

 

this needs you to have a sub-routine called sendemail which takes as a parameter some text to be sent in the message (in this case info about what you were trying to do and the name of the file you were doing it to)