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

[Teaser]

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

[LosOjos]

http://msdn.microsoft.com/en-us/libr...8VS.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)