ChatGPT isn't as good as it thinks it is! Need help with some code that isn't working.

Ok, so I've got a database I've built for tracking our companies training and certifications.

I've written some VBA code to export the data to Excel, update the cells in Excel if the fields in Access changed, and remove any data (rows) that have been deleted from the Access Database since the last run of the code.

Now, the "deleting" and “updating” of cells/rows in Excel via the VBA code is a new addition to what was working code previously.
I have attached both the working version of the code and the non-working version.

Could somebody look at this and help me out, please? ChatGPT, while helpful at times, has been messing this up lately.

Thanks,

-Mark

Ok, I made some revisions to the original NON-WORKING code I submitted.  I changed things from late-binding to early-binding and I added a lot of Error Handling to try to find the problem—It didn't work.

So, here is the error:

Also, maybe some background on what I'm trying to do:

The Access Database tracks employee training and certifications.  In the data are expiry dates for some records, but not all records.  Then I export the Access Data to Excel into a sheet called “Raw Data” (but I can change that if needed) and into a table I named “MyTable”.  The table has headers in Row #1. Then in the Excel sheet, I have two rows that calculate dates 30-Days and 90-Days before the Expiry Date that was part of the imported Access Data. Then I have VBA code in the Excel sheet that emails me anytime one of those dates triggers at 30- & 90-Day intervals and that is run on a monthly basis.  The Excel VBA code works very well.  So then as records are added, updated, removed from the Access database, the export to Excel should update the existing file with the new Access information.  Whether that be deleting rows (records), updating fields (new expiry date), etc.  That way, the Excel sheet should always match the Access database.

Please let me know if you need any clarification.

-Mark

WORKING CODE

Sub ExportTableToExcel()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim sql As String
    Dim i As Integer
    Dim path As String
    Dim lastRow As Long
    Dim xlRow As Long
    Dim found As Boolean

    On Error GoTo ErrorHandler

    ' Define the path to your existing workbook
    path = "C:\Users\mcoderre\Documents\ETB.xlsm"
    
    ' Define your SQL statement to select the data from your Access table
    sql = "SELECT * FROM ETB"

    ' Open a recordset based on your SQL statement
    Set db = CurrentDb
    Set rs = db.OpenRecordset(sql)

    ' Create a new instance of Excel
    Set xlApp = CreateObject("Excel.Application")

    ' Check if the workbook exists
    If Len(Dir(path)) = 0 Then
        ' Workbook does not exist, create a new one
        Set xlBook = xlApp.Workbooks.Add
        xlBook.SaveAs path
    Else
        ' Workbook exists, open it
        Set xlBook = xlApp.Workbooks.Open(path)
    End If

    ' Use the "Raw Data" sheet in the workbook
    ' Change the sheet name as needed
    Set xlSheet = xlBook.Worksheets("Raw Data")

    ' Find the last row in the worksheet that contains data
    lastRow = xlSheet.Cells(xlSheet.Rows.Count, "A").End(-4162).Row

    ' Loop through the recordset
    Do Until rs.EOF
        found = False
        
        ' Loop through the rows in Excel to find a matching record
        For xlRow = 2 To lastRow
            If xlSheet.Cells(xlRow, 1).Value = rs.Fields(0).Value Then
                ' Found a match, update the record
                For i = 1 To rs.Fields.Count - 1
                    ' Skip the "attached image" field
                    If rs.Fields(i).Type <> dbAttachment Then
                        If Not IsNull(rs.Fields(i).Value) Then
                            Dim fieldValue As Variant
                            fieldValue = rs.Fields(i).Value
                            
                            If IsDate(fieldValue) Then
                                ' Handle Date values
                                xlSheet.Cells(xlRow, i + 1).Value = CDate(fieldValue)
                            Else
                                ' Handle other data types
                                xlSheet.Cells(xlRow, i + 1).Value = fieldValue
                            End If
                        End If
                    End If
                Next
                found = True
                Exit For
            End If
        Next

        If Not found Then
            ' No match found, append the record
            lastRow = lastRow + 1 ' Increment lastRow by 1 before assigning new data
            For i = 0 To rs.Fields.Count - 1
                ' Skip the "attached image" field
                If rs.Fields(i).Type <> dbAttachment Then
                    If Not IsNull(rs.Fields(i).Value) Then
                        fieldValue = rs.Fields(i).Value
                        
                        If IsDate(fieldValue) Then
                            ' Handle Date values
                            xlSheet.Cells(lastRow, i + 1).Value = CDate(fieldValue)
                        Else
                            ' Handle other data types
                            xlSheet.Cells(lastRow, i + 1).Value = fieldValue
                        End If
                    End If
                End If
            Next
        End If

        rs.MoveNext
    Loop

' Save and close the workbook
xlApp.Interactive = False ' Set Interactive to False
xlBook.Close SaveChanges:=True

' Quit Excel
xlApp.Quit

' Clean up
rs.Close
Set rs = Nothing
Set db = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Interactive = True ' Set Interactive back to True
Set xlApp = Nothing

Exit Sub

ErrorHandler:
    ' Error handling block
    Debug.Print "An error has occurred: " & Err.Description
    Debug.Print "Error Source: " & Err.Source
    Debug.Print "Error Line: " & Erl
    Debug.Print "Field Name: " & rs.Fields(i).Name
    Debug.Print "Field Value: " & rs.Fields(i).Value
    MsgBox "An error has occurred: " & Err.Description, vbCritical, "Error"

    ' Clean up in case of error
    If Not rs Is Nothing Then
        If rs.EOF And rs.BOF Then ' rs is empty or not open
            rs.Close
        End If
        Set rs = Nothing
    End If

    Set db = Nothing
    Set xlSheet = Nothing

    If Not xlBook Is Nothing Then
        If xlBook.Saved = False Then xlBook.Close SaveChanges:=False
        Set xlBook = Nothing
    End If

    If Not xlApp Is Nothing Then
        xlApp.Interactive = False ' Set Interactive to False
        xlApp.Quit
        xlApp.Interactive = True ' Set Interactive back to True
        Set xlApp = Nothing
    End If

    Exit Sub
End Sub

NON-WORKING CODE

Sub ExportTableToExcel()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlTable As Excel.ListObject
    Dim sql As String
    Dim i As Long
    Dim path As String
    Dim namedRange As String
    
    ' Define the path to your existing workbook
    path = "C:\1TrainingDatabase\ETB.xlsm"
    
    ' Define the named range
    namedRange = "MyDynamicRange"
    
    ' Define your SQL statement to select the data from your Access table
    sql = "SELECT * FROM ETB"
    
    ' Open a recordset based on your SQL statement
    Set db = CurrentDb
    Set rs = db.OpenRecordset(sql)
    
    ' Create a new instance of Excel
    Set xlApp = New Excel.Application
    
    ' Check if the workbook exists
    If Len(Dir(path)) = 0 Then
        ' Workbook does not exist, create a new one
        Set xlBook = xlApp.Workbooks.Add
        xlBook.SaveAs FileName:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        ' Workbook exists, open it
        Set xlBook = xlApp.Workbooks.Open(path)
    End If
    
    ' Use the "Raw Data" sheet in the workbook
    ' Change the sheet name as needed
    Set xlSheet = xlBook.Worksheets("Raw Data")
    
    ' Clear the entire worksheet (including headers)
    xlSheet.UsedRange.ClearContents
    
    ' Define the range for the table
    Dim tableRange As Range
    Set tableRange = xlSheet.Range("A1:R392") ' Update the range to match your table's range
    
    ' Convert the range to an Excel table
    Set xlTable = xlSheet.ListObjects.Add(xlSrcRange, tableRange, , xlYes)
    xlTable.Name = "MyTable" ' Specify the name for the table
    
    ' Write data from the recordset to the table
    
    rs.MoveFirst
    
    Do Until rs.EOF
        Dim targetRow As Excel.ListRow
        Set targetRow = xlTable.ListRows.Add ' Add a new row to the table
        
        For i = 0 To rs.Fields.Count - 1
            Dim fieldValue As Variant
            fieldValue = rs.Fields(i).Value
            
            On Error Resume Next ' Temporarily disable error handling
            
            Select Case True
                Case IsNull(fieldValue)
                    targetRow.Range.Cells(1, i + 1).Value = ""
                Case IsDate(fieldValue)
                    targetRow.Range.Cells(1, i + 1).Value = CDate(fieldValue)
                    ' Apply desired date format to the target cell
                    targetRow.Range.Cells(1, i + 1).NumberFormat = "dd-mmm-yyyy" ' Change the format as per your preference
                Case TypeName(fieldValue) = "Boolean"
                    targetRow.Range.Cells(1, i + 1).Value = fieldValue
                Case Else
                    targetRow.Range.Cells(1, i + 1).Value2 = fieldValue
            End Select
            
            On Error GoTo 0 ' Reset error handling
        Next i
        
        rs.MoveNext
    Loop
    
    ' Save and close the workbook
    xlBook.Close SaveChanges:=True
    
    ' Quit Excel
    xlApp.Quit
    
    ' Clean up
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    
    Exit Sub ' Add this to make sure ErrorHandler is not executed after normal execution
    
ErrorHandler:
    ' Error handling block
    Debug.Print "An error has occurred: " & Err.Description
    Debug.Print "Error Source: " & Err.Source
    Debug.Print "Error Line: " & Erl
    MsgBox "An error has occurred: " & Err.Description, vbCritical, "Error"
    
    ' Clean up in case of error
    If Not rs Is Nothing Then
        If Not (rs.EOF And rs.BOF) Then ' Check if the recordset is open
            rs.Close
        End If
        Set rs = Nothing
    End If
    
    Set db = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    If Not xlApp Is Nothing Then
        xlApp.Quit
        Set xlApp = Nothing
    End If
    
    Exit Sub
End Sub