VBA Runtime Error 1004 âApplication-defined or Object-defined errorâ

ravi_bms · March 11th, 2015, 02:47 AM

I have code VBA code written in MS Access 2010 (.mbd file) to write data into an Excel file (.xls file). Below is the code to write data into that excel file. When you run this code, it always throws Error#1004 "Application-defined or Object-defined error". When you debug the code (F8) or run it (F5), it runs absolutely fine with out any issues. I am still not able to figure it out on what exactly the issue is. This code works fine when executed in MS Access 2007.

Below is thr code that's getting executed and when it fails, the focus is set on the 3rd last line of the code marked in double astriek mark.

Code:

Sub PopulateReport(appExcel As Object, testcam)

Dim Site As String, intRec As Integer, i As Integer, cnt As Integer, intRecSet As Integer, cntr As Integer
Dim F1 As String, F2 As String, F3 As String, F4 As String, F5 As String, F6 As String, F7 As String
Dim F8 As String, F9 As String, F10 As String, F11 As String, F12 As String, F13 As String, CAMDate As Date
Close
i = 0
cnt = 0
cntr = 0
Set cnn = CurrentProject.Connection

rec.Open "SELECT * FROM Site", cnn, adOpenStatic, adLockPessimistic
rec.MoveLast
rec.MoveFirst
intRec = rec.RecordCount
Do Until cnt = intRec
rec.MoveLast
rec.MoveFirst
    rec.Move cnt
    Site = rec(4)
    Select Case Site
        Case "Fort Worth"
            cntr = 0
            recset.Open "SELECT * FROM Employee", cnn, adOpenStatic, adLockPessimistic
            recset.MoveLast
            recset.MoveFirst
            intRecSet = recset.RecordCount
            appExcel.Application.Goto Reference:="START_FW_CL"
            Do Until cntr = intRecSet - 1
                appExcel.Selection.EntireRow.Copy
                appExcel.Selection.EntireRow.Insert
                cntr = cntr + 1
            Loop
            appExcel.Application.CutCopyMode = False
            appExcel.Application.Goto Reference:="START_FW2_CL"
            go = appExcel.Application.Range("START_FW2_CL")
            cntr = 1
             With appExcel.Worksheets("Accts. > Clearing").[START_FW2_CL]
                Do Until recset.EOF
                    **.Offset(cntr, 0) = recset(0)**
                    .Offset(cntr, 1) = recset(1)
                    .Offset(cntr, 2) = recset(2)
End Sub