Link to home
Create AccountLog in
Avatar of shambalad
shambaladFlag for United States of America

asked on

Object variable not set error (91) when creating workbook 2nd time - 1st time works

I am having a problem working with Excel objects from within an Access application. I have a form that sends data to an Excel workbook. This export process executes without error the first time around. All subsequent executions fail with an 'Object variable not set' (91). The only way to clear the error is to close out the Access aplication and restart it.
The problem appears to be with operations that work with ranges.
As near as I can tell, others have encountered this same error and asked about it in this forum, but I haven't seen a definitive answer as to why this is occurring and how to prevent it from happening.
I have attached a snippet of the actual subroutine where I an getting the error.
I have also attached an Access Database (.mdb) file. I tried to attach copy of the template (rptTAT.xlt) that the form uses, but apparently Excel templates (.xlt) are not allowed files for upload. In lieu, I uploaded a blank copy of the workbook. In order to run the application, you should first save the workbook as a template (.xlt).
I would be most grateful for any help on resolving this problem.
Thanks
Todd
Private Function DeleteColumns( _
         varDeleteColumns As Variant, _
         xlsApp As Excel.application, _
         xlsBook As Excel.Workbook, _
         strWorksheet As String) As Boolean
      Dim xlsSheet As Excel.Worksheet
      Dim strProcedure As String
      Dim intIndex As Integer
      Dim strRange As String
      Dim lngUBound As Long
      Dim strMsg As String
 
10    On Error GoTo HandleError
20    strProcedure = "DeleteColumns"
 
      ' Excel objects must be open
30    If xlsBook Is Nothing Or _
            xlsApp Is Nothing Then
40       GoTo ExitFunction
50    End If   'If xlsBook Is Nothing
            
60    xlsBook.Worksheets(strWorksheet).Select
70    Set xlsSheet = xlsBook.ActiveSheet
 
80    lngUBound = UBound(varDeleteColumns)
 
90    For intIndex = 0 To lngUBound
100      If Not IsEmpty(varDeleteColumns(intIndex)) Then
110         strRange = varDeleteColumns(intIndex)
 
'@@@@@@@@@@
'    Error 91 - 'Object variable not set' on following line:
120         ActiveSheet.Columns.Range(strRange).EntireColumn.Delete
'@@@@@@@@@@
 
130      End If      'If Not IsEmpty(varDeleteColumns(intIndex))
140   Next intIndex  'For intIndex = 0 To lngUBound
       
150   DeleteColumns = True
ExitFunction:
160   Exit Function
 
HandleError:
170   DoCmd.Hourglass False
180   strMsg = "Module: " & strModule & NL & _
                  "Procedure: " & strProcedure & _
                  NL & "Error: " & _
                  Err.Description & _
                  " (" & Err.Number & ")" & NL & _
                  "Error Line: '" & Erl & "'" & NL & _
                  "Array Index: '" & intIndex & "'" & NL & _
                  "Range: '" & strRange & "'"
190   Debug.Print strMsg
200   MsgBox strMsg
210   Resume ExitFunction
End Function

Open in new window

rptTAT.xls
Export-To-Excel-Problem.mdb
ASKER CERTIFIED SOLUTION
Avatar of StellanRosengren
StellanRosengren
Flag of Sweden image

Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
Avatar of shambalad

ASKER

Stellan -
The good news is that changing the reference from ActiveSheet to 'xlsSheet' fixed the problem in that subroutine. Now I am getting the same error in a subsequent subroutine (attached below).
This still doesn't address why the code works the first time, but bombs the second time. This would seem to suggest that this is an object clean-up issue, but I explicitly set all my Excel objects to nothing before I start so that doesn't seem to be the answer. What I am looking for is some way to initialize my Excel instance up front so that this error doesn't keep popping up in different places.
Thanks for you help on this.
Todd
Public Function fnSetDataRange( _
               xlsApp As Excel.application, _
               strRange As String, _
               xlsSheet As Excel.Worksheet, _
               Optional strFirstCell As String, _
               Optional strLastCell As String) _
               As Boolean
 
      ' Sets range of data loaded to worksheet
      ' Default assumes that first row has no headings,
      ' hence default first cell is "$A$1".
      ' If strFirstCell is passed, use that.
 
      Dim rngLastColumn As Excel.Range
      Dim rngFirstRow As Excel.Range
      Dim rngLastCell As Excel.Range
      Dim rngLastRow As Excel.Range
      Dim strProcedure As String
      Dim strSheet As String
      Dim strMsg As String
 
10    On Error GoTo HandleError
20    strProcedure = "fnSetDataRange"
 
30    strSheet = xlsSheet.name
 
40    If strFirstCell = "" Then
50       strFirstCell = "$A$1"
60    End If      'If strFirstCell = ""
 
 
'**** Now same error occurs on following line:   <=========
70    Set rngLastColumn = xlsSheet.Cells.Find("*", _
               LookIn:=xlValues, _
               SearchOrder:=xlByColumns, _
               SearchDirection:=xlPrevious _
               ).EntireColumn
 
80    Set rngLastRow = xlsSheet.Cells.Find("*", _
               LookIn:=xlValues, _
               SearchOrder:=xlByRows, _
               SearchDirection:=xlPrevious _
               ).EntireRow
90    Set rngLastCell = xlsApp.Intersect( _
               rngLastColumn, _
               rngLastRow)
100   rngLastCell.Activate
 
110   strLastCell = xlsApp.ActiveCell.Address
 
      ' Need to place cursor in A:1 prior
      ' to adding the range in order to
      ' avoid an off-set error
120   xlsSheet.Range("A1").Select
 
130   xlsApp.Names.Add name:=strRange, _
         RefersTo:=xlsApp.Selection.Range( _
               strFirstCell, _
               strLastCell)
 
140   fnSetDataRange = True
 
ExitFunction:
150   Exit Function
 
HandleError:
160   strMsg = "Module: " & strModule & NL & _
               "Procedure: " & strProcedure & NL & _
               "Error: " & Err.Description & _
               " (" & Err.Number & ")" & NL & _
               "Error Line: " & Erl
170   MsgBox strMsg
180   Resume ExitFunction
End Function

Open in new window

> "I explicitly set all my Excel objects to nothing before I start so that doesn't seem to be the answer."
For what it's worth, I added the explicit deletes for the worksheets to  the 'TransferWorksheets' function after attaching the uploaded file, so you won't see that in the code if you are looking at the mdb file attached to this question. I have attached the modified 'TransferWorksheets' function  as a snippet below.
Todd

Public Function TransferWorksheets( _
                  xlsApp As Excel.application, _
                  xlsBook As Excel.Workbook, _
                  xlsToSheet As Excel.Worksheet, _
                  strTemplate As String, _
                  strWorkbook As String, _
                  strWorksheet As String, _
                  strToCell As String, _
                  Optional strSQL As String, _
                  Optional blnCloseExcel As Boolean, _
                  Optional rst As DAO.Recordset, _
                  Optional varDeleteColumns As Variant) _
                  As Boolean
      Dim xlsFromSheet As Excel.Worksheet
      Dim blnPassedRst As Boolean
      Dim rngHome As Excel.Range
      Dim strFromRange As String
      Dim strFirstCell As String
      Dim strProcedure As String
      Dim strLastCell As String
      Dim strToRange As String
      Dim strMsg As String
 
10    On Error GoTo HandleError
20    strProcedure = TransferWorksheets
 
30    strFromRange = "FromRange"
40    strToRange = "ToRange"
 
      '*** Explicitly delete the worksheets  <===
50    If Not xlsToSheet Is Nothing Then
60       Set xlsToSheet = Nothing
70    End If   'If Not xlsToSheet Is Nothing
 
80    If Not xlsFromSheet Is Nothing Then
90       Set xlsFromSheet = Nothing
100   End If   'If Not xlsFromSheet Is Nothing
      '******************************************
 
 
110   If Not xlsBook Is Nothing Then
120      xlsBook.Close savechanges:=True
130      Set xlsBook = Nothing
140   End If         'If Not xlsBook Is Nothing
 
150   If Not xlsApp Is Nothing Then
160      xlsApp.Quit
170      Set xlsApp = Nothing
180   End If         'If Not xlsApp = Nothing
 
 
190   If strToCell = "" Then
200      strToCell = "$A$1"
210   End If            'If strToCell = ""
 
220   If rst Is Nothing Then
230      If Not strSQL = "" Then
240         Set rst = CurrentDb.OpenRecordset( _
                        strSQL, dbOpenSnapshot)
250      Else
260         strMsg = "Neither SQL nor DAO recordset passed." & NL & _
                        "TransferWorksheets procedure cancelled."
270         MsgBox strMsg
280         GoTo ExitFunction
290      End If         'If Not strSQL = ""
300   Else
310      blnPassedRst = True
320   End If            'If rst Is Nothing
 
330   If Not (rst.BOF And rst.EOF) Then
 
340      If fnCreateWorkbook(strTemplate, _
                        strWorkbook, _
                        xlsApp, _
                        xlsBook) Then
            
            ' Delete columns if array was passed
350         If Not IsMissing(varDeleteColumns) Then
360            If Not DeleteColumns( _
                        varDeleteColumns, _
                        xlsApp, _
                        xlsBook, _
                        strWorksheet) Then
370               blnCloseExcel = True
380               GoTo ExitFunction
390            End If   'If Not DeleteColumns(
400         End If      'If Not IsMissing(
            
410         With xlsBook
420            Set xlsToSheet = .ActiveSheet
430            .Sheets.Add
               'Use .Sheets(1) for now
440            Set xlsFromSheet = .Sheets(1)
               
               ' Default for CopyFromRecordset is to
               ' send data only - No heading row
450            xlsFromSheet.Range("A1").CopyFromRecordset rst
460            xlsApp.CutCopyMode = xlCopy
               
470            If fnSetDataRange( _
                        xlsApp, _
                        strFromRange, _
                        xlsFromSheet, _
                        strFirstCell, _
                        strLastCell) Then
               
480               With xlsFromSheet
490                  .Activate
500                  .Range(strFromRange).Copy
510               End With 'With xlsFromSheet
                  
520               With xlsToSheet
530                  .Activate
540                  .Range(strToCell).Select
                     
550                  xlsApp.Names.Add _
                           name:=strToRange, _
                           RefersTo:= _
                           xlsApp.Selection.Range( _
                           strFirstCell, strLastCell)
                        
560                  .Range(strToRange).PasteSpecial _
                           Paste:=xlPasteValues, _
                           Operation:=xlNone, _
                           SkipBlanks:=False, _
                           Transpose:=False
 
570                  .Range(strToCell).Select
                           
580                  End With 'with xlsToSheet
590            End If   'If fnSetDataRange(
               
600            xlsApp.DisplayAlerts = False
            
610         End With    'With xlsBook
620      End If         'If fnCreateWorkbook
630   End If            'If Not (rst.BOF And rst.EOF)
 
640   If Not blnCloseExcel Then
650      xlsApp.Visible = True
660   End If            'If Not blnCloseExcel
 
670   TransferWorksheets = True
 
ExitFunction:
680   On Error Resume Next
 
      ' Clean up the objects
690   If Not blnPassedRst Then
700      rst.Close
710      Set rst = Nothing
720   End If   'If Not blnPassedRst
 
730   If blnCloseExcel Then
740      xlsApp.DisplayAlerts = False
750      If Not xlsBook Is Nothing Then
760         xlsBook.Close savechanges:=True
770         Set xlsBook = Nothing
780      End If         'If Not xlsBook Is Nothing
         
790      If Not xlsApp Is Nothing Then
800         xlsApp.Quit
810         Set xlsApp = Nothing
820      End If         'If Not xlsApp = Nothing
830   End If            'If blnCloseExcel
 
840   Exit Function
 
HandleError:
 
850   On Error Resume Next
860   xlsApp.DisplayAlerts = False
870   blnCloseExcel = True
 
880   Select Case Err.Number
         ' SQL has an invalid field name or syntax error
         Case cstAccMissingRequiredParameter, cstAccSQLSyntaxError
890         strMsg = "Module: " & strModule & NL & _
                     "Procedure: " & strProcedure & NL & _
                     "Error: " & Err.Description & _
                     " (" & Err.Number & ")" & NL & _
                     "SQL probably invalid" & NL & _
                     "SQL String:" & NL & strSQL
900      Case Else
910         strMsg = "Module: " & strModule & NL & _
                     "Procedure: " & strProcedure & NL & _
                     "Error: " & Err.Description & _
                     " (" & Err.Number & ")" & NL & _
                     "Error Line: " & Erl
920   End Select     'Select Case Err.Number
 
930   Debug.Print strMsg
940   MsgBox strMsg
950   Resume ExitFunction
End Function

Open in new window

I misspoke when I said I had to exit the app to clear the error. I am finding that simply closing the form effectively clears the error. This got me to thinking that it may have to do with cleaning up the Excel objects in the form itself. I added explicit 'Set to Nothing' statements at the top of the procedure that executes the export. But that didn't fix it.
When I complete the first iteration without closing the form , there are no instances of Excel running in the 'processes' window in Task Manager. Doesn't matter; the 2nd go still crashes.
Stellan -
The reason I am not accepting your first posting as the answer is because your suggestion is fixing a symptom, it doesn't fix the underlying error.
Todd
Hi again
I think that you had the first error because you cannot use activesheet since it is not an object in Access. I do not understand how it could work the first round. Just started to look at the next procedure. I'll be back soon.

Regards,
Stellan
Hi Todd,

When I run SendToExcel I get the second error because xlsSheet refers to Sheet1 which is empty. There should have been data entered by the .CopyFromRecordset method? Is that right? I have not understood what you need the last cell for, but there are better methods than using .Find



Regards,
Stellan
Forgot to explain:
if the find method does not find a match it returns Nothing.  The statement
Set rngMyRange = xlsSheet.Cells.Find("*")
will not generate an error, since Set rngMyRange=Nothing is allowed
but of course the property .EntireColumn can not be used

Regards,
Stellan
Stellan -
I apologize for the delay in getting back to you. I'm not going into the office this weekend (for a change), so I will be picking this up first thing Monday morning. This issue is my number one priority at the moment, so I will be putting all of my focus on it Monday. I'll let you now how I fare.
Thanks for your attention on this.
Todd
Stellan -
You wrote:
> When I run SendToExcel I get the second error because xlsSheet refers to Sheet1 which is empty.

This is the clue I was overlooking. It turns out that the recordset being passed in was not valid on the second iteration. Of course that begs the question, why is the recordset invalid the second time round, but I am going to let that question go for now (my years in IT have taught me there is a point where you simply have to stop asking why).
Anyway, what I have done was to pass to the TransferWorksheets module the necessary parameters to create and open the recordset. Since the module is no longer generic, I re-named it "TransferWorksheetsTAT".
Now I am getting no errors. This is by no means an elegant solution; but it will do for now.
I am attaching a file with the modified objects.
Thank you for your help.
Todd
Export-To-Excel-Problem---Modifi.mdb
Todd,
Maybe I am wrong but I believe it is another question why your recordset was empty and that I solved your original question. So, at least I would like to have an explanation for why you want to reduce the points.

Regards,
Stellan
My objection is that I have spent some time analysing the problem and I believe I found the solution. The error 'Object variable not set' was caused by the use of ActiveSheet in the Access VBA project. That should not be working. It is a little confusing that the error was not encountered from the very beginning. I admit that I cannot explain this behaviour.
Then there was a second error which the asker believed was related to the first error. I pointed out that was not the case but was caused by a recordset being empty.


Regards,
Stellan
Stellan -
In reviewing this question, I agree with you. Although the raised error seems related. They are, in fact, two differnt and unrelated errors. I proved this by changing the original line back to 'ActiveSheet', while leaving the new 'OpenRecordset' code (which fixes the second error) in place. This caused the original error to recur.
I appreciate the time and effort you put into this. It allowed me to finish out this project. I am going to try to accept your first post as the proper answer.
Regards,
Todd
My apologies for this. You should get credit for answering the second question too. I am going to open a new question with the second part of this particular question, so that you can post your answer as in ths question and get credit for that too. I will add a comment with the new question number to this question as soon I post it.
Thanks,
Todd
Stellan -
Question Q_23502694 (https://www.experts-exchange.com/questions/23502694/Export-to-Excel-Object-variable-not-set-error-91-when-creating-workbook-second-time-Part-II.html)
has been opened to address the second question and answer from this page. Please add your comment about the page being empty. I will accept and award you the points.
Regards,
Todd
Hi Todd,
I am glad we sorted it out. I appreciate your feedback. Thanks for the points.

Regards,
Stellan