Application defined or object defined error (1004) with Excel

[downhilljon]

Hi all,

Been searching for a solution to my problem on here for a while, with many tantalising tidbits, but nothing seems to be working so far.

I have spent a bit of time recently modifying Allen Browne's Audit Trail code to suit my specific situation, and I am now stuck with exporting the data to Excel.

My main issue arises when I start manipulating Excel (see code for line which triggers the error), and I receive error 1004 (as per the subject of this thread).

I have read a lot of different threads on the issues that can arise when dealing with Excel through Access. I have (I think) solved the problem of Excel not shutting down after Access is finished with it by explicitly referencing any Excel related code. However, my Excel VBA knowledge is not great, which is why the rest of the code is falling down no doubt.

I have included what I think are the relevant bits of my code below - it is quite a monotonous and repetitive section of code, so I have omitted parts of it for clarity. Also, I realise my code is probably not the cleanest code around - I welcome any general suggestions on how I have done things, so I can learn from my mistakes.

Private Sub Form_Timer()
On Error GoTo Err_Form_Timer
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strName As String
Dim strFile As String
Dim strSQL As String
Dim strDateRef As String, dteDateRef As Date, dteTimeRef As Date
Dim intCounter As Integer, intCounterStart As Integer, intCounterEnd As Integer
Dim intaudID As Integer, straudType As String, dteaudDate As Date, straudUser As String
Dim intBikeID As Integer, intYearID As Integer, intBrandID As Integer, intModelID As Integer
Dim intSizeID As Integer, strColour As String, strSerialNumber As String
Dim intStatusID As Integer, strComments As String, curCostPrice As Currency, intInvoiceID As Integer
Dim strBrand As String
Dim intBuildID As Integer, intCustomerID As Integer, dteDateRequired As Date
Dim blnPrintedSlip As Boolean, intStaffID As Integer
Dim strFirstName As String, strSurname As String, strAddress As String, strSuburb As String
Dim strState As String, strPostCode As String, strWorkPhone As String, strMobilePhone As String
Dim strInvoiceNumber As String, dteInvoiceDate As Date
Dim strModel As String
Dim intOrderID As Integer, intOrderQuantity As Integer, dteOrderDate As Date
Dim intPurchaseID As Integer, curPrice As Currency, dteSaleDate As Date
Dim intPriceRangeID As Integer
 
'Check if Excel workbook is open
strName = "Audit Trail.xls"
strFile = CurrentProject.Path & "\" & strName
If IsXLBookOpen(strName) = True Then
    Set xlApp = New Excel.Application
    Set xlWB = xlApp.Workbooks.Open(strFile)
 
    With xlWB
        .Save
        .Close
    End With
    xlApp.Quit
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
End If
 
'Setup excel
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(strFile)
audBikes_In_Stock:
    'Set current sheet
    Set xlSheet = xlWB.Worksheets("audBikes_In_Stock")
 
    xlSheet.Activate
 
    'Set audID's to copy between
    intCounterStart = Nz(DMin("audID", "audBikes_In_Stock"), 0)
    intCounterEnd = Nz(DMax("audID", "audBikes_In_Stock"), 0)
 
    'Skip copying if table is empty
    If intCounterStart = 0 Then
        GoTo audBrands
    End If
 
    For intCounter = intCounterStart To intCounterEnd
        'set audBikes_In_Stock variables
        intaudID = intCounter
        straudType = Nz(DLookup("audType", "audBikes_In_Stock", "audID = " & intaudID), "")
        dteaudDate = Nz(DLookup("audDate", "audBikes_In_Stock", "audID = " & intaudID), Empty)
        straudUser = Nz(DLookup("audUser", "audBikes_In_Stock", "audID = " & intaudID), "")
        intBikeID = Nz(DLookup("BikeID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        intYearID = Nz(DLookup("YearID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        intBrandID = Nz(DLookup("BrandID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        intModelID = Nz(DLookup("ModelID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        intSizeID = Nz(DLookup("SizeID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        strColour = Nz(DLookup("Colour", "audBikes_In_Stock", "audID = " & intaudID), "")
        strSerialNumber = Nz(DLookup("SerialNumber", "audBikes_In_Stock", "audID = " & intaudID), "")
        intStatusID = Nz(DLookup("StatusID", "audBikes_In_Stock", "audID = " & intaudID), 0)
        strComments = Nz(DLookup("Comments", "audBikes_In_Stock", "audID = " & intaudID), "")
        curCostPrice = Nz(DLookup("CostPrice", "audBikes_In_Stock", "audID = " & intaudID), 0)
        intInvoiceID = Nz(DLookup("InvoiceID", "audBikes_In_Stock", "audID = " & intaudID), 0)
 
        'copy data into next available row on excel sheet
        With xlSheet.Range("A1").End(xlDown)
            .Offset(1, 0).Value = intaudID          [COLOR=red]'<------Error on this line[/COLOR]
            .Offset(0, 1).Value = straudType
            .Offset(0, 2).Value = dteaudDate
            .Offset(0, 3).Value = straudUser
            .Offset(0, 4).Value = intBikeID
            .Offset(0, 5).Value = Nz(DLookup("Year", "tblBike_Year", "YearID = " & intYearID), 0)
            .Offset(0, 6).Value = Nz(DLookup("Brand", "tblBrands", "BrandID = " & intBrandID), "")
            .Offset(0, 7).Value = Nz(DLookup("Model", "tblModels", "ModelID = " & intModelID), "")
            .Offset(0, 8).Value = Nz(DLookup("Size", "tblBike_Sizes", "SizeID = " & intSizeID), "")
            .Offset(0, 9).Value = strColour
            .Offset(0, 10).Value = strSerialNumber
            .Offset(0, 11).Value = Nz(DLookup("Status", "tblBike_Status", "StatusID = " & intStatusID), "")
            .Offset(0, 12).Value = strComments
            .Offset(0, 13).Value = curCostPrice
            .Offset(0, 14).Value = intInvoiceID
        End With
 
        'Empty Variables
        straudType = ""
        dteaudDate = Empty
        straudUser = ""
        intBikeID = 0
        intYearID = 0
        intBrandID = 0
        intModelID = 0
        intSizeID = 0
        strColour = ""
        strSerialNumber = ""
        intStatusID = 0
        strComments = ""
        curCostPrice = 0
        intInvoiceID = 0
 
    Next intCounter
audBrands:
 
[COLOR=red]'Repetitive code sits in here[/COLOR]
 
 
With xlWB
    .Save
    .Close
End With
Continue:
xlApp.Quit
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Exit Sub
'Clear all 'aud...' tables when finished
 
    'Empty the audit tables
    DoCmd.SetWarnings False 'Turn confirmation boxes off
    strSQL = "DELETE FROM audBikes_In_Stock;"
    DoCmd.RunSQL strSQL
 
    strSQL = "DELETE FROM audBrands;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audBuilds;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audCustomers;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audInvoices;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audModels;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audOrders;"
    DoCmd.RunSQL strSQL
    strSQL = "DELETE FROM audSold_Bikes;"
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True 'Turn confirmation boxes on
Exit_Form_Timer:
    Exit Sub
Err_Form_Timer:
    MsgBox Err.Description & Err.Number
    Resume Continue
End Sub

I hope this all makes sense, and I appreciate any attempts to figure this one out.

Cheers,
Jon

 

[namliam]

        'copy data into next available row on excel sheet
        With xlSheet.Range("A1").End(xlDown) [COLOR="Red"][B]<==This is your actual problem!!![/B][/COLOR]
            .Offset(1, 0).Value = intaudID          '<------Error on this line

Your Range("A1").End(xlDown) moves you to the last line that is filled IF anything is filled.
I am betting that your excel sheet right now consists of a header row and NO data at all.
The End(xlDown) will then send you to row 65536, after which the Offset(1,0) will try to move down 1 row which it cannot and then trigger your error.

So you have to catch this circumstance and fix it seperately as it is the only time this will happen.

Good luck!

 

[downhilljon]

yep, that did the trick!!! Thanks heaps mailman. It's usually something simple!!!
Jon