Excel To Access: Error Checking

[AndrewKent]

Hi there,

I have a series of macros that transmit data from an Excel worksheet to fields within an ".mdb" file. Although what I am doing is a working process and I am fixing any errors as they turn up I am looking to keep an automatic log of these (as I have a user base that don't always feed bugs back!!)

An example of one of the macros is this...

Sub UpdateRecord()

'   =============================================================================================
'   This macro will firstly connect to the Access database. It will then update every field in
'   each table based on the criteria that has been set. In order to simplify the code structure,
'   the coding to update each table has been placed in individual macros.
'   =============================================================================================

    Dim DBName, DBLocation, FilePath As String
    Dim DBConnection As ADODB.Connection
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set DBConnection = New ADODB.Connection
    DBName = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseName").Value
    DBLocation = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseLocation").Value
    FilePath = DBLocation & DBName

    With DBConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open FilePath
    End With
    
    Worksheets("Data Capture").Range("C5").Value = Worksheets("Calculation Matrix").Range("CalculationMatrix_Search").Value
    Worksheets("Data Capture").Range("C8").Value = Worksheets("Staff Data").Range("E5").Value
    Worksheets("Data Capture").Range("C9").Formula = "=Now()"
    Worksheets("Data Capture").Select
    Range("C9").Copy
    Range("C9").PasteSpecial xlPasteValues
    Worksheets("Data Capture").Range("C12").Value = False
    
    Call UpdateIndex(DBConnection)
    Call UpdateCustomerData(DBConnection)
    Call UpdateCTFData(DBConnection)
    Call UpdateGCBData(DBConnection)
    Call UpdateCombiData(DBConnection)
    Call UpdateTrackerFundData(DBConnection)
    Call UpdateStakeholderData(DBConnection)

    DBConnection.Close
    Set DBConnection = Nothing
    
    Worksheets("Index").Activate
    Range("A1").Select

End Sub

Sub UpdateIndex(DBConnection As ADODB.Connection)

'   =============================================================================================
'   This macro is responsible for updating one table within the database. It is called by the
'   UpdateRecord macro as part of a routine.
'   =============================================================================================

    Dim DBRecordSet As ADODB.Recordset
    Dim Query As String
    
    Query = "SELECT * FROM tblIndex WHERE Record_ID = '" & Worksheets("Calculation Matrix").Range("CalculationMatrix_Search").Value & "'"

    Set DBRecordSet = New ADODB.Recordset
    DBRecordSet.CursorLocation = adUseServer
    DBRecordSet.Open Source:=Query, ActiveConnection:=DBConnection, CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText

    With DBRecordSet
        .Fields("Record_ID") = Worksheets("Data Capture").Range("C5").Value
        .Fields("Created_By") = Worksheets("Data Capture").Range("C6").Value
        .Fields("Created_Date") = Worksheets("Data Capture").Range("C7").Value
        .Fields("Modified_By") = Worksheets("Data Capture").Range("C8").Value
        .Fields("Modified_Date") = Worksheets("Data Capture").Range("C9").Value
        .Fields("Stakeholder_ID") = Worksheets("Data Capture").Range("C10").Value
        .Fields("Brand") = Worksheets("Data Capture").Range("C11").Value
        .Fields("Active_Status") = Worksheets("Data Capture").Range("C12").Value
        .Fields("Record_Status") = Worksheets("Data Capture").Range("C13").Value
        .Fields("ReferralTracker_Reference") = Worksheets("Data Capture").Range("C14").Value
        .Fields("ModifiedBy_SellerCode") = Worksheets("Data Capture").Range("C15").Value
        .Fields("NSO_Reason") = Worksheets("Data Capture").Range("C16").Value
        .Fields("Campaign_Code") = Worksheets("Data Capture").Range("C17").Value
        .Update
    End With

    DBRecordSet.Close
    Set DBRecordSet = Nothing

End Sub

However I need to add two error checks to this.

1) to check that firstly the table the code is trying to update exists in the database
2) to check that a record with the unique key exists in that table.

I have other similar routines for creating records and finding records in an ".mdb" file but this one is for updating an existing record. If I can find out how to check these points, I can then decide what my program will do if this happens.

Many thanks in advance,

Andy

 

[RoryA]

You cna check for a record existing with that key by checking the recordset's EOF or BOF property after opening it. If either is True, there is no such record.
For the table check, do you specifically need to check for the existence of the table or can you simply use an error check round the recordset open statement? (If an error occurs, then there is something wrong with the connection or the SQL string, such as the table not existing)

 

[AndrewKent]

Yeah, if I could simply add in one check that would be great, the record existing would be the more frequent of the two (for example if I've added in tables AFTER a record had been created in other tables). I've seen the EOF/BOF debug come up before but I'm not sure how to write the code to specifically pin-point if either is True, further more, how to update the routine I have to add this in.

Sorry, I am still a bit new to transmitting data between Excel and Access with VBA so any exampled you can give to get me kicked off would be very useful.

Andy

 

[RoryA]

Something along the lines of:

Sub UpdateIndex(DBConnection As ADODB.Connection)
'   =============================================================================================
'   This macro is responsible for updating one table within the database. It is called by the
'   UpdateRecord macro as part of a routine.
'   =============================================================================================
   Dim DBRecordSet As ADODB.Recordset
   Dim Query As String
   Dim wks As Worksheet
   
   On Error GoTo err_handle
   
   Set wks = Worksheets("Data Capture")
   Query = "SELECT * FROM tblIndex WHERE Record_ID = '" & _
                  Worksheets("Calculation Matrix").Range("CalculationMatrix_Search").Value & "'"
   
   Set DBRecordSet = New ADODB.Recordset
   DBRecordSet.CursorLocation = adUseServer
   On Error Resume Next
   DBRecordSet.Open Source:=Query, ActiveConnection:=DBConnection, CursorType:=adOpenForwardOnly, _
                        LockType:=adLockOptimistic, Options:=adCmdText
   On Error GoTo err_handle
   If Err.Number <> 0 Then
      ' something went wrong with the connection or SQL string
      ' log error here
   Else
   
      With DBRecordSet
         If .bof Or .EOF Then
            ' no matching records
            ' log error here
         Else
            .Fields("Record_ID") = wks.Range("C5").Value
            .Fields("Created_By") = wks.Range("C6").Value
            .Fields("Created_Date") = wks.Range("C7").Value
            .Fields("Modified_By") = wks.Range("C8").Value
            .Fields("Modified_Date") = wks.Range("C9").Value
            .Fields("Stakeholder_ID") = wks.Range("C10").Value
            .Fields("Brand") = wks.Range("C11").Value
            .Fields("Active_Status") = wks.Range("C12").Value
            .Fields("Record_Status") = wks.Range("C13").Value
            .Fields("ReferralTracker_Reference") = wks.Range("C14").Value
            .Fields("ModifiedBy_SellerCode") = wks.Range("C15").Value
            .Fields("NSO_Reason") = wks.Range("C16").Value
            .Fields("Campaign_Code") = wks.Range("C17").Value
            .Update
         End If
      End With
   End If
   
   DBRecordSet.Close
   Set DBRecordSet = Nothing
End Sub

 

[AndrewKent]

Okay that's sort of along the same lines as I was thinking, although where you've put "On Error GoTo err_handle" I don't see "err_handle:" for where it should jump to? Is err_handle an error handling statement in VBA?

 

[RoryA]

Nope - that's just me being lazy! You would need to add your own err_handle section...

 

[AndrewKent]

Hi there,

Okay I have updated my coding so that the program has a routine to carry out if it can't find a record in a particular table (EOF BOF Err.Number 1004). Here's what I've done...

Sub FindRecord()

'   =============================================================================================
'   This macro will firstly connect to the Access database. It will then look in each table
'   within the database for records that match the selected criteria. Once found, the value in
'   each field is returned to the Data Capture worksheet.In order to simplify the code structure,
'   the coding to retrieve data from each table has been placed in individual macros.
'   =============================================================================================

    Dim DBName, DBLocation, FilePath As String
    Dim DBConnection As ADODB.Connection
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set DBConnection = New ADODB.Connection
    DBName = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseName").Value
    DBLocation = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseLocation").Value
    FilePath = DBLocation & DBName

    With DBConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open FilePath
    End With
    
    Call FindIndex(DBConnection)
    Call FindCustomerData(DBConnection)
    Call FindCTFData(DBConnection)
    Call FindGCBData(DBConnection)
    Call FindCombiData(DBConnection)
    Call FindTrackerFundData(DBConnection)
    Call FindStakeholderData(DBConnection)

    DBConnection.Close
    Set DBConnection = Nothing
    
    Worksheets("Index").Activate
    Range("A1").Select

End Sub

...and...

Sub FindStakeholderData(DBConnection As ADODB.Connection)

'   =============================================================================================
'   This macro is responsible for updating one table within the database. It is called by the
'   FindRecord macro as part of a routine.
'   =============================================================================================

    Dim DBRecordSet As ADODB.Recordset
    Dim Query As String
    
    On Error Resume Next
    
    Query = "SELECT * FROM tblStakeholderData WHERE Record_ID = '" & Worksheets("Calculation Matrix").Range("CalculationMatrix_Search").Value & "'"

    Set DBRecordSet = New ADODB.Recordset
    DBRecordSet.CursorLocation = adUseServer
    DBRecordSet.Open Source:=Query, ActiveConnection:=DBConnection, CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText

    With DBRecordSet
        If .BOF Or .EOF Then
            Call ErrorLog
            Call CreateStakeholderData(DBConnection)
        Else
            Worksheets("Data Capture").Range("C5").Value = .Fields("Record_ID")
            Worksheets("Data Capture").Range("U5").Value = .Fields("Stakeholder_Code")
            Worksheets("Data Capture").Range("U6").Value = .Fields("Stakeholder_Name")
            Worksheets("Data Capture").Range("U7").Value = .Fields("Managerial_Level_1")
            Worksheets("Data Capture").Range("U8").Value = .Fields("Managerial_Level_2")
            Worksheets("Data Capture").Range("U9").Value = .Fields("Stakeholder_Area")
            Worksheets("Data Capture").Range("U10").Value = .Fields("LeadGen_SortCode")
        End If
    End With

    DBRecordSet.Close
    Set DBRecordSet = Nothing

End Sub

...I decided against coding to handle a missing table or missing field because really those are bugs that should be fixed during testing.

Andy

 

[RoryA]

The only thing I would add, is that rather than using

Worksheets("Data Capture")

repeatedly, it's easier to use a worksheet variable assigned once at the top of the routine. Then if you need to change it, you only have to do so in one place!

 

[AndrewKent]

Well noted...I'd actually gone about this a different way as I didn't know how to write a variable for this. Thankfully I don't have to manually change every Data Capture line!