CopyFromRecordset Automation Error

Did you try to use ADO instead of DAO, and a simple query? (DAO seems to be deprecated).

Thanks for the reply. This is a utility that is used with many, many record sources. changing to ADO would be very time consuming and not worth it when it currently works everywhere else.

When a process fails after an extended period of success, and with not changes to the code, the first suspect is a change in the data, either datatypes or missing values most likely.

Examine the data where this process fails. It's possible that the error message is misleading.

Thanks George. Forgot to mention, I had done that also. Even tried a simple recordset that only returns 3 columns with 4 rows. Old copy of database as well as fresh copy.

I am getting the same issue on my development machine with the Current channel (2501), but it's not happening on other computers with the semi-annual version of Office.

I've been using the CopyFromRecordset method for 10+ years in many applications and now it's giving me error 430. I did an Office repair and reboot and it still gives an error.

I'm hoping to come across someone else who has encountered this error and narrowed down the problem. I'm using late binding but when I tried early binding I get the same result. I did try to re-register dao360.dll with no change in behavior.

If you want to test on your computer, open Access and make a query named qryTest, then run the routine below.

Sub ExportToExcel()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    
    On Error GoTo ErrorHandler
    
    ' Initialize objects
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("qryTest", dbOpenSnapshot)
    
    ' Create Excel application object
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    ' Add new workbook and set reference to first sheet
    Set xlWorkbook = xlApp.Workbooks.Add()
    Set xlWorksheet = xlWorkbook.Worksheets(1)
    
    ' Copy headers from recordset
    Dim i As Integer
    For i = 0 To rs.Fields.Count - 1
        xlWorksheet.Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i
    
    ' Format headers
    With xlWorksheet.Range(xlWorksheet.Cells(1, 1), _
                          xlWorksheet.Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .Interior.ColorIndex = 5
        .HorizontalAlignment = -4108 'xlCenter
    End With
    
    ' Copy recordset data starting from row 2
    xlWorksheet.Range("A2").CopyFromRecordset rs  ' <-- This is the line that is giving error 430 for some users.
    
    ' Auto-fit columns
    xlWorksheet.UsedRange.Columns.AutoFit
    
    ' Clean up
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, vbCritical, "Error"
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

The query shouldn't matter. A simple result like this should work.

__qryTest__Building_IDBuilding102FAB1103HPM1-S107CUB1108PROBE1109ADMIN1110PARK1113SITE118B120119B140

 Windows Version:   10.0.22631.4890
 Windows Bitness:   64-bit OS
 Office Version:    16.0.18429.20158
 Office Platform:   x86
 Release:           2501