Jump to content

Recommended Posts

Posted

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 = "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 :

 

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

' 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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now



×
×
  • Create New...