Exlent error handling for vbs and database accessing

Test · 发表于 2013-5-24 09:00:41

本帖最后由 Test 于 2013-5-24 09:01 编辑

uses the resume next and emails out the name of the file that has an error. But at the moment if 1 of the 10 rows in the file are fine it will load that 1 row and still send the email.

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 = "gf"
strSqlConnection.Properties("Initial Catalog").Value = "e-df"
strSqlConnection.Properties("User ID").Value = "df"
strSqlConnection.Properties("Password").Value = "dfs"
strSqlConnection.Properties("Integrated Security").Value = "dsf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(objStartFolder) Then
On Error Resume Next
Set objFolder = objFSO.GetFolder(objStartFolder)
For each objFile In objFolder.Files
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
'Check if the excel file was opened
If err.number <> 0 Then
SendMail "Openning Excel file = " & objFile.Path, err.Description
DTSTaskExecResult_Failure
Exit Function
End If
Set rstXlResults = CreateObject("ADODB.Recordset")
rstXlResults.Open strXlSQL, dbXlConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
'Check if recordset was able to be created from the ex file
If err.number <> 0 Then
SendMail "Error creating recordset", err.Description
DTSTaskExecResult_Failure
Exit Function
End If
If Not (rstXlResults.bof and rstXlResults.eof) then
arrXlData = rstXlResults.GetRows
rstXlResults.Close
'Check if there was a problem creating an array from the recordset row
If err.number <> 0 Then
SendMail "Unable to create array from recordset row", err.Description
DTSTaskExecResult_Failure
Exit Function
End If
Set rstXlResults = Nothing
dbXlConnect.Close
Set dbXlConnect = Nothing
if isarray(arrXlData) then
Set dbSqlConnect = CreateObject("ADODB.Connection")
dbSqlConnect.Open strSqlConnection
'Check if there was a problem opening the connection
If err.number <> 0 Then
SendMail "Unable to open the dbSqlConnect connection", err.Description
DTSTaskExecResult_Failure
Exit Function
End If
for x=0 to ubound(arrXlData,2) ' Loop data and insert into db
' Destination table and array
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
dbSqlConnect.Execute strSQL
'Check if there was a problem doing the insert
If err.number <> 0 Then
SendMail "Insert error", err.Description
DTSTaskExecResult_Failure
Exit Function
End If
next
set dbSqlConnect = nothing
set arrXlData = nothing
end if
End If
End If
Next
End If
set objFSO = Nothing
Main = DTSTaskExecResult_Success
End Function
Sub SendMail(ByVal eSource, ByVal eDescription)
Dim iMsg, strBody
'Use COM to create Message and Configuration Objects
Set iMsg = CreateObject("CDO.Message")
strBody = "Error Source: " & eSource & "
" & "Error Description: " & eDescription
' Apply the settings to the message.
With iMsg
.To = "dg.df@df-df.co.uk"
'If Not IsNull(strCC) Then .CC = strCC
.From = "df@ff-df.co.uk"
.Subject = "MONTHLY load has failed" & objFile & " "
.HTMLBody = strBody
.Send
End With
' Clean up variables.
Set iMsg = Nothing
End Sub

复制代码

Test · 发表于 2013-5-24 09:10:15

本帖最后由 Test 于 2013-5-24 09:12 编辑

If you do not want loading any data from a file where there is an issue with 1 or more rows of data in that file.
e.g. for the code above, if row 3 has an issue, it will load 1,2 send the error email and then continue loading the rest of the rows. How about if I want it to fail to load all together if there is an error before any data is loaded.

Add a transaction to the connection object would give out this need.

Also, moved all the insert code into its own procedure so you should be able to continue on with the next file if the current file fails.

Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
Function Main()
dim strSqlConnection
dim objFSO
dim objStartFolder
dim objFolder
dim objFile
objStartFolder = "F:\Metastorm BPM\MDS\Output"
Set strSqlConnection = CreateObject("ADODB.Connection")
strSqlConnection.Provider = "sqloledb"
strSqlConnection.Properties("Data Source").Value = "gf"
strSqlConnection.Properties("Initial Catalog").Value = "e-df"
strSqlConnection.Properties("User ID").Value = "df"
strSqlConnection.Properties("Password").Value = "dfs"
strSqlConnection.Properties("Integrated Security").Value = "dsf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(objStartFolder) Then
On Error Resume Next
Set objFolder = objFSO.GetFolder(objStartFolder)
For each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile) = "xls" Then
InsertData objFile, strSqlConnection
End If
Next
End If
set objFSO = Nothing
Main = DTSTaskExecResult_Success
End Function
Sub InsertData(oFile, oConn)
Dim dbXlConnect
Dim rstXlResults
Dim strXlSQL
Dim arrXlData
Dim dbSqlConnect
Dim strSQL
strXlSQL = "SELECT * FROM [Sheet1$A3:T65000]"
On Error Resume Next
Set dbXlConnect = CreateObject("ADODB.Connection")
dbXlConnect.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & oFile.Path & ";Extended Properties=""Excel 8.0;HDR=Yes;"";" ' Excel Object connection properties
'Check if the excel file was opened
If err.number <> 0 Then
SendMail "Openning Excel file = " & oFile.Path, err.Description
Exit Sub
End If
Set rstXlResults = CreateObject("ADODB.Recordset")
rstXlResults.Open strXlSQL, dbXlConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
'Check if recordset was able to be created from the ex file
If err.number <> 0 Then
SendMail "Error creating recordset", err.Description
Exit Sub
End If
If Not (rstXlResults.bof and rstXlResults.eof) then
arrXlData = rstXlResults.GetRows
rstXlResults.Close
'Check if there was a problem creating an array from the recordset row
If err.number <> 0 Then
SendMail "Unable to create array from recordset row", err.Description
Exit Sub
End If
Set rstXlResults = Nothing
dbXlConnect.Close
Set dbXlConnect = Nothing
if isarray(arrXlData) then
Set dbSqlConnect = CreateObject("ADODB.Connection")
dbSqlConnect.Open oConn
'Check if there was a problem opening the connection
If err.number <> 0 Then
SendMail "Unable to open the dbSqlConnect connection", err.Description
Exit Sub
End If
dbSqlConnect.BeginTrans
for x=0 to ubound(arrXlData,2) ' Loop data and insert into db
' Destination table and array
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) & "')"
dbSqlConnect.Execute strSQL
'Check if there was a problem doing the insert
If err.number <> 0 Then
dbSqlConnect.RollbackTrans
SendMail "Insert error" & oFile.Path, err.Description
Exit Sub
End If
next
dbSqlConnect.CommitTrans
set dbSqlConnect = nothing
set arrXlData = nothing
end if
End If
End Sub
Sub SendMail(ByVal eSource, ByVal eDescription)
Dim iMsg, strBody
'Use COM to create Message and Configuration Objects
Set iMsg = CreateObject("CDO.Message")
strBody = "Error Source: " & eSource & "
" & "Error Description: " & eDescription
' Apply the settings to the message.
With iMsg
.To = "dg.df@df-df.co.uk"
'If Not IsNull(strCC) Then .CC = strCC
.From = "df@ff-df.co.uk"
.Subject = "MONTHLY load has failed" & objFile & " "
.HTMLBody = strBody
.Send
End With
' Clean up variables.
Set iMsg = Nothing
End Sub

复制代码

Good programmer MarkT

账号		自动登录	找回密码
密码			注册

Exlent error handling for vbs and database accessing

浏览过的版块