code fails after second loop

[ino_mart]

All

For some reason next code fails after second loop on line
oXL.Range("A" & Rows.Count).End(xlUp).Offset(1).Activate

The first loop works perfect. I even have to reopen the form to get it work. Does someone have a solution or an idea why this code fails?

lstData is a listbox. The purpose is to put data into an Excel workbook. The data is placed on first empty row on sheet which corresponds with rs!subcategory

Private Sub cmdExport_Click()
 
Dim strSQL As String
Dim rs As Recordset
Dim oXL As Object
Dim wrk As Object
Dim intX As Integer
Dim strSubCat As String
Dim strCategory As String
For intX = 0 To Me.lstData.ListCount - 1
    If Me.lstData.Selected(intX) = True Then
        strCategory = Me.lstData.ItemData(intX)
        strSQL = "select * from tblData where category='" & strCategory & "'"
        Set rs = CurrentDb.OpenRecordset(strSQL)
        Set oXL = CreateObject("Excel.Application")
        Set wrk = oXL.Workbooks.Add(1)
        wrk.Application.Worksheets.Add.Name = "Category"
        wrk.Application.Worksheets.Add.Name = "Subcategory"
        wrk.Application.Worksheets.Add.Name = "BIZ"
        wrk.Application.Worksheets.Add.Name = "Data"
        wrk.Application.Worksheets.Add.Name = "Cable"
        oXL.Visible = True
 
        While Not rs.BOF And Not rs.EOF
            strSubCat = rs!subcategory
            wrk.Worksheets(strSubCat).Activate
            oXL.Range("A" & Rows.Count).End(xlUp).Offset(1).Activate
            oXL.ActiveCell.Offset(0, 0) = rs!state
            oXL.ActiveCell.Offset(0, 1) = rs![planned start date]
 
            rs.MoveNext
        Wend
        wrk.SaveAs "c:\temp\" & strCategory
 
        wrk.Close
        oXL.Quit
 
        Set wrk = Nothing
        Set oXL = Nothing
 
    End If
Next
End Sub

 

[DavidAtWork]

Have you tried stepping through the code to see where it's failing.
Check the values in Me.lstData.ListCount
There is one line which possibly looks suspect, the line Set oXL = CreateObject("Excel.Application")
You may want to try testing to see if Excel is running, if it is then use getObject() otherwise createObject()

David

 

[JHB]

You are missing a pointer to Excel in the below line, because "Rows" is not a function in MS-Access but it is in Excel.

oXL.Range("A" & Rows.Count).End(xlUp).Offset(1).Activate

 

[ino_mart]

@JHB, many thanks. This was indeed the problem. After adding oxl. before Rows.count, the code runs withouth problem.

oXL.Range("A" & oxl.Rows.Count).End(xlUp).Offset(1).Activate

 

[JHB]

You're welcome!