Occasional Error in code to Add sheet to Excel workbook from Access

[Isskint]

Well i had a few minutes spare, so i took some of Bobs code (many thanks Bob) and adapted it to a situation in this post http://www.access-programmers.co.uk/forums/showthread.php?t=236372. What i have is a generic procedure that can be called by supplying the name of the table or query you wish to save and the field name you wish to use as tab names on the spreadsheet.

Public Sub TransferByTab(sFormName As String, sKeyonField As String)
    'Based on some code from Bob Larson
    'at [URL="http://www.btabdevelopment.com/ts/default.aspx?PageId=10"][COLOR=#810081]http://www.btabdevelopment.com/ts/default.aspx?PageId=10[/COLOR][/URL]
    'Many thanks Bob
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim oLP, xlNxtRw As Integer
    Dim xlFound As Boolean
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
 
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset(sFormName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
 
    'delete all but sheet1
    For oLP = 1 To xlWBk.Sheets.Count - 1
        xlWBk.Worksheets(xlWBk.Sheets.Count).Delete
    Next oLP
 
    rst.MoveFirst
 
    'set name and column headings for first sheet
    xlWBk.Worksheets(1).Name = rst(sKeyonField)
    For Each fld In rst.Fields
        If fld.Name <> sKeyonField Then ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    While Not rst.EOF
        xlFound = False 'boolean flag indicates named sheet found
        For oLP = 1 To xlWBk.Sheets.Count
            If xlWBk.Worksheets(oLP).Name = rst(sKeyonField) Then
                Set xlWSh = xlWBk.Worksheets(oLP) 'set reference to this worksheet
                xlWSh.Select
                xlFound = True
            End If
        Next oLP
 
        If xlFound = False Then 'no sheet with name of current records sKeyonField
            [COLOR=red][B]xlWBk.Worksheets.Add After:=Worksheets(xlWBk.Sheets.Count)[/B][/COLOR]
            Set xlWSh = xlWBk.Worksheets(xlWBk.Sheets.Count)
            xlWSh.Name = rst(sKeyonField)
 
            For Each fld In rst.Fields
                If fld.Name <> sKeyonField Then ApXL.ActiveCell = fld.Name
                ApXL.ActiveCell.Offset(0, 1).Select
            Next
 
            xlFound = True
        End If
 
        xlNxtRw = ApXL.ActiveSheet.UsedRange.Rows.Count + 1 'next empty row on selected sheet
 
        oLP = 1
        For Each fld In rst.Fields
            If fld.Name <> sKeyonField Then
                ApXL.Cells(xlNxtRw, oLP) = rst(fld.Name)
                oLP = oLP + 1
            End If
        Next
        rst.MoveNext
    Wend
 
    rst.Close
    Set rst = Nothing
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Sub
 
End Sub

This code ran sucessfully a dozen times then tripped at the line in red. the error is Method 'Worksheets' of object '_Global' failed.
I have run it sucessfully since but it does sometimes trip up still and I have NO IDEA WHY:banghead:. Perhaps someone can identify why it should trip up on the Add sheet line 'whenever the mood takes it'. I don't want to post it to the OP on the other thread until the bug if sorted.

 

[thechazm]

This error happens when the focus of the excel document gets shifted to another instance of excel.

So what I mean by that is lets say I run some code to output to excel then I open up a different excel file. What happens is that file I just opened now becomes a part of my current excel instance that my code opened. This shifts the focus and can sometimes break your code.

If the excel documents were already open before your code is ran then you should not have any error's but opening an excel document while your code is still running can/will cause problems.

This issue was introduced in 2007 because by default excel tries to open one instance of excel for all workbooks.

Hopefully this helps and it may not be exactly your issue but I know anytime you shift the focus in the instance where your code is trying to run you will get that error.

 

[Isskint]

Thanks for that clarification.

That would make sense if i had any other workbooks open, however Excel was not running prior to running the code so the only instance of Excel is the one created by the code. Even so, if I had another instance of Excel running, I don't get why the code will only fail sometimes. Just MS I suppose.

 

[thechazm]

The same situation would apply if you code did not completly close out of the last instance of excel properly. I noticed in the example code you posted you do not clear/close all the objects that you have used with your excel instance. Keep track in your task manager and make sure it's completly closing your last session of excel otherwise it's pretty much the same scenario.

One last tip to try and reduce any errors I would only make your excel document visible after all of your outputs and changes have occured.

Normally you would open and close excel objects something like the following.

Function ImportShopGangs(strFile As String)
Dim xlsApp As Excel.Application, xlsWorkbook As Excel.Workbook, xlsSheet As Excel.Worksheet
 
Set xlsApp = New Excel.Application
Set xlsWorkbook = xlsApp.Workbooks.Open(strFile)
Set xlsSheet = xlsWorkbook.Worksheets(1)
 
' Do stuff with the excel file here...
 
 
Set xlsSheet = Nothing
Set xlsWorkbook = Nothing
xlsApp.Quit
Set xlsApp = Nothing

Hope it helps and good luck.

 

[Isskint]

I have added code to close the instance of Excel but i still get the same problem. The attached is a screen shot of the task manager before running the code AFTER it had succesfully run. As you can see there is no instance of Excel running but it still gives me the same error message.

Strangely though, if i quit Access and then restart the code will run OK for the first run through. So is it an issue within Access (or the automation)??

 

[thechazm]

The issue is with the Automation object. Try addapting your code using the code I posted above and see if you get different results.

 

[Rx_]

Just a quick observation. The Set Worksheet that has something happening at the Workbook level - then a worksheet that might Occasionally be added to the Workbook level. This is something I would tend to avoid.
The main reason I would avoid it is because it makes my brain work too hard.
Wondering if you can remove the Set for the worksheet and replace it with code using an index reference from the workbook?
It would at least make the code in that area easier to read. If it makes your error go away ... call it a solution.

Example mid-way - different way to reference a worksheet:
http://www.techrepublic.com/blog/10...ence-excel-workbooks-and-sheets-using-vba/967

At least indexes help me keep track of things. For me, it is easy to loose track of pointers when they involve conditional loops back to the same object. Sorry I can't be of more help.

        For oLP = 1 To xlWBk.Sheets.Count
            If xlWBk.Worksheets(oLP).Name = rst(sKeyonField) Then
' sets reference here                
Set xlWSh = xlWBk.Worksheets(oLP) 'set reference to this worksheet
                xlWSh.Select
                xlFound = True
            End If
        Next oLP
 
        If xlFound = False Then 'no sheet with name of current records sKeyonField
' once in a while - adds worksheet to parent - is reference above still held? I am not sure if that interaction between the other worksheet in memory and a Worksheet.Add causes a problem or not.
            [COLOR=red][B]xlWBk.Worksheets.Add After:=Worksheets(xlWBk.Sheets.Count)[/B][/COLOR]
            Set xlWSh = xlWBk.Worksheets(xlWBk.Sheets.Count)

 

[boblarson]

This part

xlWBk.Worksheets.Add After:=Worksheets(xlWBk.Sheets.Count)

is erroneous as Worksheets (after the = sign) is not tied to any instantiated object. You would need to use

xlWBk.Worksheets.Add After:=xlWbk.Worksheets(xlWBk.Sheets.Count)

Read this for more about why:
http://www.btabdevelopment.com/ts/excelinstance

 

[Rx_]

Eagle Eye Bob nailed it.
I just couldn't see it.

 

[Isskint]

This part

xlWBk.Worksheets.Add After:=Worksheets(xlWBk.Sheets.Count)

is erroneous as Worksheets (after the = sign) is not tied to any instantiated object. You would need to use

xlWBk.Worksheets.Add After:=xlWbk.Worksheets(xlWBk.Sheets.Count)

Read this for more about why:
http://www.btabdevelopment.com/ts/excelinstance

So simple and yet so unobtrusive:banghead: Applied this to the code and it does not suffer the problem now.

Many thanks RX, TheChazam and Bob.

Amended code, including save file to nominated file path.

Public Sub TransferByTab(sFormName As String, sKeyonField As String, sFilePath As String)
    'Based on some code from Bob Larson
    'at [URL]http://www.btabdevelopment.com/ts/default.aspx?PageId=10[/URL]
    'Many thanks Bob
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim oLP, xlNxtRw As Integer
    Dim xlFound As Boolean
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset(sFormName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
    
    'delete all but sheet1
    For oLP = 1 To xlWBk.Sheets.Count - 1
        xlWBk.Worksheets(xlWBk.Sheets.Count).Delete
    Next oLP
    
    rst.MoveFirst
    
    'set name and column headings for first sheet
    xlWBk.Worksheets(1).Name = rst(sKeyonField)
    
    For Each fld In rst.Fields
        If fld.Name <> sKeyonField Then ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    
    Set xlWSh = Nothing
    
    While Not rst.EOF
        xlFound = False 'boolean flag indicates named sheet found
        For oLP = 1 To xlWBk.Sheets.Count
            If xlWBk.Worksheets(oLP).Name = rst(sKeyonField) Then
                Set xlWSh = xlWBk.Worksheets(oLP) 'set reference to this worksheet
                xlWSh.Select
                xlFound = True
            End If
        Next oLP
        
        If xlFound = False Then 'no sheet with name of current records sKeyonField
            xlWBk.Worksheets.Add After:=xlWBk.Worksheets(xlWBk.Sheets.Count)
            Set xlWSh = xlWBk.Worksheets(xlWBk.Sheets.Count)
            xlWSh.Name = rst(sKeyonField)
            
            For Each fld In rst.Fields
                If fld.Name <> sKeyonField Then ApXL.ActiveCell = fld.Name
                ApXL.ActiveCell.Offset(0, 1).Select
            Next
            
            xlFound = True
        End If
        
        xlNxtRw = ApXL.ActiveSheet.UsedRange.Rows.Count + 1 'next empty row on selected sheet
        
        oLP = 1
        For Each fld In rst.Fields
            If fld.Name <> sKeyonField Then
                ApXL.Cells(xlNxtRw, oLP) = rst(fld.Name)
                oLP = oLP + 1
            End If
        Next
        rst.MoveNext
    Wend
    
    xlWBk.SaveAs (sFilePath & sFormName & ".xls")
    
TBTexit:
    rst.Close
    Set xlWSh = Nothing
    Set xlWBk = Nothing
    ApXL.Quit
    Set ApXL = Nothing
    Set rst = Nothing
    Exit Sub
    
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    GoTo TBTexit
    
End Sub