+ Post New Thread
Results 1 to 8 of 8
Coding Thread, VB ERROR HANDLING in Coding and Web Development; Hi Guys, I have two sets of code. The first one basically looks in a folder, identifies the xls files ...
  1. #1

    Join Date
    Jul 2010
    Posts
    25
    Thank Post
    1
    Thanked 0 Times in 0 Posts
    Rep Power
    0

    VB ERROR HANDLING

    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
    Last edited by Teaser; 23rd September 2010 at 08:44 AM.

  2. #2

    Join Date
    Jul 2010
    Posts
    25
    Thank Post
    1
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    forgot to say, individually they work fine. Am just trying to integrate them.

  3. #3

    LosOjos's Avatar
    Join Date
    Dec 2009
    Location
    West Midlands
    Posts
    5,487
    Thank Post
    1,445
    Thanked 1,181 Times in 808 Posts
    Rep Power
    709

  4. #4

    LosOjos's Avatar
    Join Date
    Dec 2009
    Location
    West Midlands
    Posts
    5,487
    Thank Post
    1,445
    Thanked 1,181 Times in 808 Posts
    Rep Power
    709
    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...

  5. #5

    LosOjos's Avatar
    Join Date
    Dec 2009
    Location
    West Midlands
    Posts
    5,487
    Thank Post
    1,445
    Thanked 1,181 Times in 808 Posts
    Rep Power
    709
    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

  6. #6

    Join Date
    Jul 2010
    Posts
    25
    Thank Post
    1
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    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

  7. #7
    neodong's Avatar
    Join Date
    Dec 2010
    Posts
    7
    Thank Post
    0
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    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

  8. #8

    Join Date
    Aug 2005
    Location
    London
    Posts
    3,156
    Thank Post
    116
    Thanked 529 Times in 452 Posts
    Blog Entries
    2
    Rep Power
    124
    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,
    Code:
    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)

SHARE:
+ Post New Thread

Similar Threads

  1. Error Handling
    By Teaser in forum Scripts
    Replies: 5
    Last Post: 22nd September 2010, 02:13 PM
  2. Audit logging and incident handling
    By k-strider in forum How do you do....it?
    Replies: 4
    Last Post: 20th March 2009, 12:13 PM
  3. Leicestershire: Information Handling
    By russdev in forum East Midlands Broadband Consortium (EMBC)
    Replies: 0
    Last Post: 30th January 2009, 10:47 AM

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •