Run-time error 91 Every Other Execution

cekendricks
cekendricks used Ask the Experts™
on
I have a small piece of code that writes the results of a query to an excel spreadsheet and then performs some minor formatting of the spreadsheet via a second sub-procedure.  The behavior that I am seeing is that every other time I run the main procedure it works just fine, but the other times it fails with "Run-time error 91  Object variable or With block variable not set".  In checking other message boards, some have determined that the Excel application wasn't closed properly.  Does not the line 'Set xlApp = Nothing' accomplish that task?  Oh!..The line that is highlighted when it fails is the very first line of the CreateStyle() sub procedure: ActiveWorkbook.Styles.Add "cek1"

Public Sub ExportOrders()

    Dim xlApp As Excel.Application
    'Dim xlApp As Object
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim xlRng As Excel.Range
    Dim xlRng2 As Excel.Range
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim x As Integer, y As Integer, z As Integer
    Dim strSql As String
    Dim strSt As String
   

    'Set xlApp = CreateObject("Excel.Application")
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")
   
    Set db = CurrentDb
    strSt = "CA"
    strSql = "SELECT OrderNumber, BillingFirstName, BillingLastName, BillingAddress1, " & _
             "BillingCity, BillingState, BillingZip FROM tblOrders WHERE BillingState = ""CA"""
    Debug.Print strSql
    Set rs = db.OpenRecordset(strSql)
   
    xlApp.Visible = True
    xlWs.Select
    Set xlRng = xlWs.Cells(4, 1)
   
    x = 4
   
    While Not rs.EOF
        For y = 1 To rs.Fields.Count
            xlRng.Cells(x, y) = rs.Fields(y - 1).Value
        Next y
        x = x + 1
        rs.MoveNext
    Wend
   
    Set xlRng = xlWs.Range(xlWs.Cells(4, 1), xlWs.Cells.SpecialCells(xlCellTypeLastCell))
    Set xlRng2 = xlRng.Columns(7)
   
    Call CreateStyle
    xlRng2.Style = "cek1"
   
    Set xlApp = Nothing
    Set xlWb = Nothing
   
       
End Sub
-----------------------------------------------------------
Public Sub CreateStyle()
   
    ActiveWorkbook.Styles.Add "cek1"
    With ActiveWorkbook.Styles("cek1")
        .Font.Bold = True
        .Font.Size = 16
        .Font.ColorIndex = 28
       
    End With
End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

Commented:
Not sure, but I think you have to close/quit the Excel instance also

    xlApp.quit
    Set xlApp = Nothing
    Set xlWb = Nothing
   
Owner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010
Commented:
Try modifying the subroutine to:

Public Sub CreateStyle(wbk as Excel.Workbook)

    wbk.styles.add "cek1"
    with wbk.styles("cek1")
        .Font.Bold = True
        .Font.Size = 16
        .Font.ColorIndex = 28
    end with

End Sub

Then change the call to the subroutine to:

Call CreateStyle(xlWb)

Lastly, you might want to consider using the CopyFromRecordset method to move your data from your recordset to EXCEL, it is much quicker than the manual method you are using now.

Replace:

Set xlRng = xlWs.Cells(4, 1)
   
    x = 4
   
    While Not rs.EOF
        For y = 1 To rs.Fields.Count
            xlRng.Cells(x, y) = rs.Fields(y - 1).Value
        Next y
        x = x + 1
        rs.MoveNext
    Wend

With:

Sheet.range("A4").CopyFromRecordset rs  'copy the data



Dale FyeOwner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
Sorry, that CopyFromRecordset reference should have been:

xlWs.range("A4").CopyFromRecordset rs

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial