Error 91 only at run-time

[PRMiller2]

Feel like I'm asking for a lot of help lately! I have a procedure that is being called to parse through Excel files. It works fine when one Excel file is passed to the procedure. It also works fine when the procedure is called multiple times (ie a loop that calls the procedure, passing a workbook name, then calling the procedure again and passing a second workbook name, etc), but only in debug mode. At runtime, I receive "Error 91: Object variable or With block variable not set."

Here's the code:

Public Function EditExcel(ByVal strFileName As String)
On Error GoTo Err_Handler

    Dim appExcel As Excel.Application
    
    DoEvents
    Set appExcel = GetExcelApp()
    
    appExcel.Workbooks.Open strFileName
    appExcel.Visible = False

    DoEvents
    With appExcel.Sheets(1)
        If .Range("A1").value = "Super Pharmacy" Then
            appExcel.Worksheets(1).Rows(1).Delete
            .Range("A1").value = "SuperPharmacyNetworkID"
            .Range("B1").value = "RxNetworkID"
            .Range("C1").value = "ResolvedSrvProvID"
            .Range("D1").value = "PharmacyNme"
            .Range("E1").value = "AFFRelationshipID"
            .Range("F1").value = "CarrierID"
            .Range("G1").value = "AccountID"
            .Range("H1").value = "GroupID"
            .Range("I1").value = "TCDMemberID"
            .Range("J1").value = "RxClaimNum"
            .Range("K1").value = "ClaimSeqNbr"
            .Range("L1").value = "SbmRxNumber"
            .Range("M1").value = "SbmDteFilled"
            .Range("N1").value = "DateSubmitted"
            .Range("O1").value = "SbmDaysSupply"
            .Range("P1").value = "TCDSbmQtyDispensed"
            .Range("Q1").value = "SbmProductSelectionCde"
            .Range("R1").value = "MultiSrcCode"
            .Range("S1").value = "GenericIndOverride"
            .Range("T1").value = "SbmCompoundCde"
            .Range("U1").value = "TCDSbmProductIDQual"
            .Range("V1").value = "TCDSbmProductID"
            .Range("W1").value = "PRDDescriptionAbbrev"
            .Range("X1").value = "GPINumber"
            .Range("Y1").value = "PDTPhrCostTypeCde"
            .Range("Z1").value = "PDTPhrPriceType"
            .Range("AA1").value = "CostTypePerUnitCost"
            .Range("AB1").value = "TCDSbmIngredientCst"
            .Range("AC1").value = "TCDSbmDispensingFee"
            .Range("AD1").value = "SBMTotalSalesTax"
            .Range("AE1").value = "TCDSbmGrossAmtDue"
            .Range("AF1").value = "TCDSbmUsualAndCustomary"
            .Range("AG1").value = "AverageWholesaleUnitPr"
            .Range("AH1").value = "PDTCalPhrIngredCost"
            .Range("AI1").value = "PDTCalPhrDispFee"
            .Range("AJ1").value = "CalPhrTotSalesTax"
            .Range("AK1").value = "PDTCalPhrPatPayAmt"
            .Range("AL1").value = "PDTCalPhrTotalAmtDue"
            .Range("AM1").value = "PDTPhrIngredientCost"
            .Range("AN1").value = "PDTPhrDispensingFee"
            .Range("AO1").value = "PhrTotalSalesTax"
            .Range("AP1").value = "PDTPhrTotalPatPayAmt"
            .Range("AQ1").value = "PDTPhrTotalAmountDue"
            .Range("AR1").value = "PDTPhrWithholdAmount"
            .Range("AS1").value = "FinalPlanCde"
            .Range("AT1").value = "TCDClaimStatus"
            .Range("AU1").value = "PDTPharPriceSchedName"
            .Range("AV1").value = "PharmacyPriceTableName"
            .Range("AW1").value = "PD3PhrDrgCostSchedID"
            .Range("AX1").value = "PD3PhrDrgCstCompSchd"
            .Range("AY1").value = "PDTPharPatientSchdNme"
            .Range("AZ1").value = "PharmacyPatSchedTable"
            .Range("BA1").value = "PDTPharFeeSchedNme"
            .Range("BB1").value = "PDTPhrIncentiveAmount"
            .Range("BC1").value = "PDTPharTaxSchedName"
            .Range("BD1").value = "PharmacyNetworkNDCList"
            .Range("BE1").value = "PharmacyNetworkGPIList"
            .Range("BF1").value = "PlanGPIListName"
            .Range("BG1").value = "PlanNDCListName"
            .Range("BH1").value = "TC3ProdPreferredLstID"
            .Range("BI1").value = "SbmPriorAuthMedCerCd"
            .Range("BJ1").value = "PAMCNBR"
            .Range("BK1").value = "SpecialtyPgm"
            .Range("BL1").value = "SpecialtyInd"
            .Range("BM1").value = "SpecialtySched"
        End If

        appExcel.ActiveWorkbook.Save
        DoEvents
    End With
    
    appExcel.ActiveWorkbook.Saved = True
    DoEvents
    appExcel.Workbooks.Close
    DoEvents
    appExcel.Quit
    
    Set appExcel = Nothing
    Debug.Print strFileName
    EditExcel = 1

Exit_Handler:
    Exit Function

Err_Handler:
    If Err.Number = 1004 Then
        MsgBox "Please close Excel before continuing.", vbOKOnly + vbExclamation, "Prime Mail Audit"
        EditExcel = 0
    Else
        Call LogError(Err.Number, Err.Description, "frmProcessAudit.EditExcel()")
    End If
    Resume Exit_Handler
    
End Function

As you can see, I've entered a number of "DoEvents" statements, hoping the processor just needed to catch up. That doesn't seem to have done the trick.

At debug, the code errors out on the line "Set appExcel = GetExcelApp()".

Thanks in advance!

 

[jedraw]

Have you defined this function somewhere?
GetExcelApp()

 

[PRMiller2]

Hi jedraw, thanks for the reply. My apologies, I should have posted that earlier. Here's that function:

Public Function GetExcelApp() As Object
' If Excel is open, return reference to it
' else establish reference to it
    On Error Resume Next
    
    Set GetExcelApp = GetObject(, "Excel.Application")
    
    If Err.Number = 429 Then
        Set GetExcelApp = CreateObject("Excel.Application")
    End If

End Function

The error is occurring in my work environment: Windows XP Professional, Access 2003 (2007 is also loaded).

I was able to run this at home just now without generating an error: Windows Vista, Access 2007 (DB remains in 2003 format).

This leads me to believe that it is related to the environment. I am relatively certain that is has to do with the way I am binding within that environment. I'm not sure why it would run error-free in one environment without the other. Further... am I correct in the assumption that I am using early binding?

 

[PRMiller2]

Wondering if this could be related to a registry setting. I just discovered that the problem I posted at

http://www.tek-tips.com/viewthread.cfm?qid=1662024&page=1

also does not occur in my home environment.

Pondering experimenting with HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Jet 4.0 keys, but a bit nervous to do so (yes, I'll back up the registry first).

 

[PRMiller2]

Continuing my trouble-shooting on this. I compared the registry settings for HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Jet 4.0 on my office machine (where I receive the errors) against those same settings on my home laptop (where I do not). The only difference was in MaxBufferSize, which was set to 0 on my home machine and 6144 at work. I changed the MaxBufferSize to 0, rebooted, but still had the same problems.

I then opened the database with Access 2007 at work, compiled, but had the same problem.

So, the problems don't appear to be related to registry settings in the Jet 4.0 engine key, and they don't appear to be version specific.

What should I check next?

 

[jedraw]

I'm not an Excel person. However, I did some googling and noticed that this error sometimes occurs when the program isn't on the machine/PC involved.

Here's a quote

It's possible that you are trying to create an instance of a class (an object) from a class that is present on the machines you tested it on, but not on the machine it's been deployed to..... for example, I happen to know that I can make a VB program utilize a class for Nero Burning Rom.... I can make a nero object, and use it's methods and properties...... but that will only work on machines that have the Nero libraries installed. If it's not installed, when you try to make the object (either through early or late bindings with new or createobject), the variable that SHOULD refer to the object is still set to Nothing, because the library failed to create an instance of the requested class.....

Basically, you are trying to make an object from a class that doesn't exist on the NT box.

here's another

There are two steps to creating an object variable. First you must declare
the object variable. Then you must assign a valid reference to the object
variable using the Set statement. Similarly, a With...End With block must be
initialized by executing the With statement entry point. This error has the
following causes and solutions:

You attempted to use an object variable that isn't yet referencing a valid
object.
Specify or respecify a reference for the object variable. For example, if
the Set statement is omitted in the following code, an error would be
generated on the reference to MyObject:

Dim MyObject As Object ' Create object variable.
Set MyObject = Sheets(1) ' Create valid object reference.
MyCount = MyObject.Count ' Assign Count value to MyCount.

You attempted to use an object variable that has been set to Nothing.
Set MyObject = Nothing ' Release the object.
MyCount = MyObject.Count ' Make a reference to a released object.

Respecify a reference for the object variable. For example, use a new Set
statement to set a new reference to the object.

The object is a valid object, but it wasn't set because the object library
in which it is described hasn't been selected in the References dialog box.
Select the object library in the Add References dialog box.

The target of a GoTo statement is inside a With block.
Don't jump into a With block. Make sure the block is initialized by
executing the With statement entry point.

Good luck

 

[PRMiller2]

jedraw, thank you for the research. I'm not sure if this is the right track, though. Remember, the code does execute in its entirety the first time it is called from my form's main menu. However, if a loop is occurring calling it multiple times, it will fail on this machine. Here's a simplified version I wrote to test:

Public Function EditExcel4()
On Error GoTo Err_Handler

    Dim i As Integer
    Dim strFileName As String
    Dim appExcel As Excel.Application
    Set appExcel = GetExcelApp()
    
    For i = 1 To 5
        Select Case i
            Case 1
                strFileName = "C:\Documents and Settings\prmiller\My Documents\Master Docs\PRIMEMAILAUDIT_07_01_074036_001.XLS"
            Case 2
                strFileName = "C:\Documents and Settings\prmiller\My Documents\Master Docs\PRIMEMAILAUDIT_07_01_074036_002.XLS"
            Case 3
                strFileName = "C:\Documents and Settings\prmiller\My Documents\Master Docs\PRIMEMAILAUDIT_07_01_074036_003.XLS"
            Case 4
                strFileName = "C:\Documents and Settings\prmiller\My Documents\Master Docs\PRIMEMAILAUDIT_07_01_074036_004.XLS"
            Case 5
                strFileName = "C:\Documents and Settings\prmiller\My Documents\Master Docs\PRIMEMAILAUDIT_07_01_074036_005.XLS"
        End Select
        
        appExcel.Workbooks.Open strFileName
        appExcel.Visible = False
    
        With appExcel.Sheets(1)
            If .Range("A1").value = "Super Pharmacy" Then
                appExcel.Worksheets(1).Rows(1).Delete
                .Range("A1").value = "SuperPharmacyNetworkID"
                .Range("B1").value = "RxNetworkID"
                .Range("C1").value = "ResolvedSrvProvID"
                .Range("D1").value = "PharmacyNme"
                .Range("E1").value = "AFFRelationshipID"
            End If
    
            appExcel.ActiveWorkbook.Save
        End With
        
        appExcel.ActiveWorkbook.Saved = True
        appExcel.Workbooks.Close
        DoEvents
        
    Next i
        
    appExcel.Quit
    Set appExcel = Nothing
        
End Function

To recap, this code will work on my machine here at work through the first loop. That's because Excel is installed on this machine. It will, however, error the second time through, or when i = 2.

I reinstalled Access 2003, and now I can run this when called from the immediate window. However, it errors out when called from from my user's menu. So, we're heading in the right direction. I'll trace things back and, if I find a solution, I'll post it... or more problems, LOL.

 

[PRMiller2]

I found a work-around. Not a solution, but it gets the job done. This procedure is actually called from another one, which loops through file names, calling the procedure each time with a new file name. I removed the "Dim appExcel As xcel.Application" and "Set appExcel = GetExcelApp()" from the EditExcel procedure. I now execute the two lines in the originating procedure and pass the object to EditExcel:

Public Function EditExcel(ByVal appExcel As excel.Application, varFileName As Variant)

I set the object to nothing only after the loop is completed.

 

[MajP]

hat happens if you only create a new server session?

Public Function GetExcelApp() As Excel.Application
'establish reference to it
    Set GetExcelApp = CreateObject("Excel.Application")
End Function

 

[MajP]

The reason I say this is you wrote your function to return an object not an excel.application. Also the function uses errror trapping for program control. Both could cause problems.

It seems to me from your problem and your work around that the function is not returning a pointer when the excel server is already running.

 

[PRMiller2]

Hi MajP, not sure I understand what you're saying, but definitely curious, and want to eliminate any potential problems. To put everything in context and show desired functionality, here's how steps are processed (with unrelated code removed for brevity).

When a user selects the appropriate option from the menu, it triggers the following:

Private Sub lstMenuItem_Click()
On Error GoTo Err_Handler
    
    Dim lngFlags As Long
    Dim intNumItems As Integer
    Dim strFilter As String
    Dim strInitialDir As String
    Dim varFiles As Variant
    
    gintMenuItemID = Me.lstMenuItem.Column(0)
    
    Select Case gintMenuID
        Case 1 'Mail Audit
            strInitialDir = "C:\Documents and Settings\prmiller\My Documents\Master Docs"        
            lngFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
                
            varFiles = ahtCommonFileOpenSave(InitialDir:=strInitialDir, _
                       Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
                       DialogTitle:="Please select one or more raw input files:")
                
            DoEvents
            If IsArray(varFiles) Then
                MailAudit (varFiles)
            Else
                If varFiles = "" Then
                    MsgBox "No file selected.", vbOKOnly
                    Exit Sub
                Else
                    MailAudit (varFiles)
                End If
            End If
    End Select
    
Exit_Handler:
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, "sfmMenuOption02.lstMenuItem_Click()")
    Resume Exit_Handler
    
End Sub

The Windows File Open/Save Dialog Box functions called to populate varFiles were written by Ken Getz and are referenced at

http://access.mvps.org/access/api/api0001.htm.

My use of most of that code is here:

http://www.tek-tips.com/viewthread.cfm?qid=1662024&page=1

The MailAudit sub called from sfmMenuOption02.lstMenuItem_Click() is here:

Public Sub MailAudit(ByVal varFiles As Variant)
On Error GoTo Err_Handler

    Dim appExcel As excel.Application
    Dim intProgress As Integer
    Dim intProgressBarMax As Integer

    Set appExcel = GetExcelApp()
    Set dbCurrent = CurrentDb
    
    intProgress = 1
    intProgressBarMax = 105
    DoCmd.OpenForm "frmProgressMeter"
    Call ProgressMeter(intProgress, intProgressBarMax)
    
    DoCmd.Hourglass True
    DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000

    'Edit each of the selected files to ensure that column headers are uniform and only take up one row
    If Not IsNull(varFiles) Then
        If IsArray(varFiles) Then
            intFileCount = UBound(varFiles)
            For intCounter = 0 To intFileCount
                If (EditExcel(appExcel, varFiles(intCounter))) = 0 Then
                    Set dbCurrent = Nothing
                    DoCmd.Close acForm, "frmProgressMeter"
                    DoCmd.Hourglass False
                    Exit Sub
                End If
                DoEvents
            intProgress = intProgress + 1
            Call ProgressMeter(intProgress, intProgressBarMax)
            Next intCounter
        Else
            If (EditExcel(appExcel, varFiles)) = 0 Then
                    Set dbCurrent = Nothing
                    DoCmd.Close acForm, "frmProgressMeter"
                    DoCmd.Hourglass False
                Exit Sub
            End If
        End If
    End If

    appExcel.Quit
    Set appExcel = Nothing

Exit_Handler:
    DAO.DBEngine.SetOption dbMaxLocksPerFile, 9500
    Set dbCurrent = Nothing
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, "frmProcessAudit.MailAudit()")
    DoCmd.Close acForm, "frmProgressMeter"
    DoCmd.Hourglass False
    Resume Exit_Handler
    
End Sub

The ProgressMeter called here isn't really related to the Excel function, but wanted to leave it in this snippet to show that there are some other processes occurring.

Here's GetExcelApp:

Public Function GetExcelApp() As Object
' If Excel is open, return reference to it
' else establish reference to it
    On Error Resume Next
    
    Set GetExcelApp = GetObject(, "Excel.Application")
    
    If Err.Number = 429 Then
        Set GetExcelApp = CreateObject("Excel.Application")
    End If

End Function

The EditExcel function in question is here:

Public Function EditExcel(ByVal appExcel As excel.Application, varFileName As Variant)
On Error GoTo Err_Handler

    appExcel.Workbooks.Open varFileName
    appExcel.Visible = False

    With appExcel.Sheets(1)
        If .Range("A1").value = "Super Pharmacy" Then
            appExcel.Worksheets(1).Rows(1).Delete
            .Range("A1").value = "SuperPharmacyNetworkID"
            .Range("B1").value = "RxNetworkID"
            .Range("C1").value = "ResolvedSrvProvID"
        End If

        appExcel.ActiveWorkbook.Save
    End With
        
    appExcel.ActiveWorkbook.Saved = True
    appExcel.Workbooks.Close
    EditExcel = 1 'Excel files prepped, ok to proceed with import and audit
    DoEvents
        
Exit_Handler:
    Exit Function

Err_Handler:
    If Err.Number = 1004 Then
        MsgBox "Please close Excel before continuing.", vbOKOnly + vbExclamation, "Prime Mail Audit"
        EditExcel = 0 'Excel files not prepped, do not proceed with import and audit
    Else
        Call LogError(Err.Number, Err.Description, "frmProcessAudit.EditExcel6()")
    End If
    Resume Exit_Handler
        
End Function