Run-time error 91

[scubadiver007]

I have made some amendments and, after much struggle, I have got it to do what I need but I now get this run-time error 91 on the line in red almost at the end.

Object variable or With block variable not set

The code worked before I did the amendments but now it isn't.

Option Compare Database
Option Explicit
 
    Dim xlApp As Excel.Application
Private Sub Export_statements1_Click()
    Dim db As DAO.Database
    Dim rstTable As DAO.Recordset
    Dim rstExcel As DAO.Recordset
    Dim mySQL As String
    Dim FileName As String
 
    'Set up
    Set db = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set rstTable = db.OpenRecordset("SELECT distinct KCode FROM tble_activity where kcode='K81638';")
    rstTable.MoveFirst
 
    'Don't need to check for .eof and .bof here, you've already got everying in a loop
    'If the table has no records, rstTable will just skip the loop
    Do Until rstTable.EOF
        'You can change the file name to whatever you want as long
        'as it will create different file names for each record
        FileName = "Quarterly Submissions and Payments - " & rstTable("KCode")
        'Set up your SQL and bring in the value of KCode for this record
        mySQL = "SELECT * from [statement activity src] where gppracticecode= '" & rstTable("KCode") & "' union " & _
                "SELECT * from [statement activity opiates] where KCode= '" & rstTable("KCode") & "' union " & _
                "SELECT * from [statement activity R] where KCode= '" & rstTable("KCode") & "' union " & _
                "SELECT * from [statement activity NPT] where KCode= '" & rstTable("KCode") & "' ;"
        db.QueryDefs("STATEMENT Activity").SQL = mySQL
 
        mySQL = "SELECT * from [statement payment src] where KCode= '" & rstTable("KCode") & "' union " & _
                "SELECT * from [statement payment R] where KCode= '" & rstTable("KCode") & "' union " & _
                "SELECT * from [statement payment NPT] where KCode= '" & rstTable("KCode") & "' ;"
        db.QueryDefs("STATEMENT Payment").SQL = mySQL
 
        mySQL = "SELECT Tble_Services.Service, Tble_Services.ID_Signup  " & _
            "FROM Tble_Services INNER JOIN Tble_Provision ON Tble_Services.ID_Service = Tble_Provision.ID_Service " & _
            "WHERE (((Tble_Provision.Kcode)='" & rstTable("KCode") & "')) "
        db.QueryDefs("STATEMENT signup src").SQL = mySQL
 
 
        'Set up your recordset for export using your export query
        Set rstExcel = db.OpenRecordset("STATEMENT export")
        'Call our Export function and give it our recordset and new file name
        ExportExcel rstExcel, FileName
        'Move to the next record
        rstTable.MoveNext
    Loop
    xlApp.Quit
    rstTable.Close
    [B][COLOR=red]rstExcel.Close[/COLOR][/B]
 
 
    Set xlApp = Nothing
    Set rstTable = Nothing
    Set rstExcel = Nothing
End Sub

 

[pr2-eugin]

Might be because you are trying to close an object that might have not been set yet.. so try this..

       [COLOR=Blue][B]:
[/B][/COLOR]       [COLOR=Blue][B]:[/B][/COLOR]
       Set rstExcel = db.OpenRecordset("STATEMENT export")
       [COLOR=SeaGreen] 'Call our Export function and give it our recordset and new file name[/COLOR]
        ExportExcel rstExcel, FileName
       [COLOR=YellowGreen][COLOR=SeaGreen]'[/COLOR][COLOR=SeaGreen]Move to the next record[/COLOR][/COLOR]
        rstTable.MoveNext
       [COLOR=Blue] rstExcel.Close[/COLOR]
    Loop
    xlApp.Quit
       [COLOR=Blue][B]:
[/B][/COLOR]       [COLOR=Blue][B]:[/B][/COLOR]

 

[NigelShaw]

Randomly enough, I had this error tonight on an application that I haven't changed. The last time I opened it, it worked fine and I created a accde. Now, I get the error 91. odd!

I'll look through my code in more detail but when I debug it, its fine and when I get the error, it doesn't take me to the problem code!

N


Sent from my OMNIA7 using Board Express

 

[boblarson]

Nigel:

That can be a bear to diagnose. I had to do that one time and I wound up having to add a line to be able to use in the error message when it occured. I had an idea of which module it was in but nothing after that. So I used something like this (was a pain to put in and then pull out):

Private Sub Form_BeforeUpdate(Cancel As Integer)
   Dim strError As String
   On Error GoTo Err_Handler
 
   strError = "If Me.Test <> 2 Then"
     If Me.Test <> 2 Then
   strError = "Cancel = True"
        Cancel = True
    Else
      strError = "Me.LastUpdated = Environ("username")
        Me.LastUpdated = Environ("username")
    End If
 
Exit_MySub:
    Exit Sub
 
Err_Handler:
   Msgbox err.Description & vbCrLf & strError, vbExclamation, err.Number
   Resume Exit_MySub
   Resume
   
End Sub

 

[scubadiver007]

Might be because you are trying to close an object that might have not been set yet.. so try this..

       [COLOR=blue][B]:[/B][/COLOR]
       [COLOR=blue][B]:[/B][/COLOR]
       Set rstExcel = db.OpenRecordset("STATEMENT export")
       [COLOR=seagreen]'Call our Export function and give it our recordset and new file name[/COLOR]
        ExportExcel rstExcel, FileName
       [COLOR=yellowgreen][COLOR=seagreen]'[/COLOR][COLOR=seagreen]Move to the next record[/COLOR][/COLOR]
        rstTable.MoveNext
       [COLOR=blue]rstExcel.Close[/COLOR]
    Loop
    xlApp.Quit
       [COLOR=blue][B]:[/B][/COLOR]
       [COLOR=blue][B]:[/B][/COLOR]

This is what I changed it to. I'm not sure if this is what you implied but the error remains.

'Set up your recordset for export using your export query
        Set rstExcel = db.OpenRecordset("STATEMENT export")
        'Call our Export function and give it our recordset and new file name
        ExportExcel rstExcel, FileName
        'Move to the next record
        rstTable.MoveNext
        rstExcel.Close
    Loop
    xlApp.Quit
    rstTable.Close
 
 
    Set xlApp = Nothing
    Set rstTable = Nothing
    Set rstExcel = Nothing

 

[vbaInet]

It seems your object never gets set. I think you should be looking into why it doesn't get set - solve that problem and you solve this one too.

Anyway, to circumvent this problem, you can use an ADODB recordset which allows you to check the State of the object whether it's open or closed. If you still want to continue using DAO and you still can't find why the object isn't getting set, just put an On Error Resume Next statement before that line and remember to resume your error handler straight after that line.

Regarding your loop, it's best you write it like this:

Do While Not rst.EOF

 

[scubadiver007]

If I comment out:

'rstTable.Close
'rstExcel.Close

it works with no errors.

 

[vbaInet]

Did you pay any attention to what was mentioned in my post?

 

[msowards]

If I comment out:



it works with no errors.

It's always best to put in error trap
in my global declarations modual I have a template routine that I can copy to any procedure. (use 'replace all' focused on current procedure and change Just_a_holding_place with the name of the procedure)

Then you can add a case for error.number = 91 and do with as you like.

In this case your record set is not always being set so when it is you need the close statement, but when it's not the close statement throws an error. Catch that error and just say resume next (in the case statement) if you want to ignore it.

Oh and ErrChoice is a Global const

Private Sub Just_a_Holding_Place()
'this is a holder to add error catchers to other subs
' to use: recopy this code below and
' then copy the modules code below where indicated
' then use the find/replace to replace "Just_a_holding_place"
' pay attenion to the passed in parameters
' then Cut the combined code
' and past over thr original module
On Error GoTo Err_Just_a_Holding_Place

'
'  insert the other module code here
'
  
Exit_Just_a_Holding_Place:
    Exit Sub

Err_Just_a_Holding_Place:
    Select Case Err.Number
        Case Else
            Dim ErrAns As Integer, ErrMsg As String
            If ErrChoice = vbYesNoCancel Then
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure." & vbCrLf & "or 'Cancel' to break into code"
            Else
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure."
            End If
            ErrAns = MsgBox(ErrMsg, _
                vbCritical + vbQuestion + ErrChoice, "Just_a_Holding_Place")
                'vbCritical + vbQuestion + errchoice, Me.Name & ": Just_a_Holding_Place")
            If ErrAns = vbYes Then
                Resume Next
            ElseIf ErrAns = vbCancel Then
                On Error GoTo 0
                Resume
            Else
                Resume Exit_Just_a_Holding_Place
            End If
    End Select
End Sub