Microsoft Access 例程生成的 Excel 报告出现错误 1004：方法打开对象工作簿失败

Question

I have several Excel reports reports that are launched on demand by buttons on a MS Access database application. The routine that launches these reports has worked fine for years with no issues, until last week when our share drive hit storage capacity.

Please note, I use a convention of a ready-made Excel Workbook that has most of the formatting to produce the final report, and adding the data to it by using VBA with the Excel Object library to build my final report. I call these "Templates" not to be associated in anyway with Microsoft Word template conventions. To avoid confusion, I will mark my reference to this convention throughout this description as Template***

The errors have become significantly less frequent since share drive space was freed up by the IT team here, but for about 30% of users, the following error is still returned when launching an excel download: "Error 1004: Method Open Object Workbooks Failed".
The line of code where the error hits has never had issues before:

Set WB = xlApp.Workbooks.Open(strPathToTemplate)

Where strPathToTemplate is the share drive path where the excel Template*** is saved.

After many calls with our IT, one help desk person applied the following solution: Navigate to ,locate a Microsoft Macro-Enabled Word Template file titled "Normal.dotm" and rename it to "Old.Normal.dotm". This IMMEDIATELY restored the functionality of the excel report downloads from the dashboard. The help desk person couldn't/wouldn't explain how they knew this was the issue or why it affected the excel downloads. The problem now is that although this solution works for every user I've applied it to, it's also temporary. Every time the user reboots, the normal.dotm file restores itself and has to be renamed again or the 1004 error will appear in the dashboard again.

I've called back to the help desk and haven't gotten any farther with an explanation or a more permanent solution.

My biggest question (aside from how to permanently solve this) is why does this MS Word normal.dotm file have any affect at all on excel files launched from the MS Access database? There are zero instances in the programming where we refer to this roaming templates file path and we don't use Word at all. I can find plenty online about how the normal.dotm file can cause problems in Word, but nothing on how it can affect other Microsoft applications other than Word.

Again, the convention I use to produce my Excel reports even though I call them Template*** has nothing to do with normal.dotm. I can't help but think that this IT help desk introduced a different problem.

Things I've tried:
1. Freeing more share drive space
2. Deleting all instances of temp files from the share drive
3. Compact and Repair on Access
4. using new excel Template*** files
5. Rewriting paths of excel Template***
6. ensuring there are no personal macros in MS word
7. Rewriting the procedure that creates the excel reports to do early binding instead of late binding
8. Rebooting several times on different computers to prove that restoration of the normal.dotm file is what causes the errors to return in the dashboard
9. Testing the dotm file renaming solution on other users' computers.

I provide as much of the vba code that may be in question below

Here is the main vba for the launch of our Status of Funds report where I use a formatted Excel workbook Template*** to produce the report by 'marrying' it to the data.

Sub CreateSOFRpt(strPathtoTemplate As String, bEOM As Boolean)

Dim strWHERE As String
Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSavePath As String
strSavePath = Environ$("UserProfile") & "\Documents\Status of Funds as of " & datestring & ".xlsm"

'This first part of the IF statement is launched only when bEOM (end of month reports) = true and if the user chooses to launch the reports.
'There are no data restrictions here because the only people who can launch end of month are the Comptroller's personnel

    If bEOM = True Then

        strSQL = "SELECT * FROM tbl_SOF_TRUECOMM IN '" & SharedRoot & "\02_Engines\SABRS.accdb';"
        strSQL1 = "SELECT * FROM tbl_SOF_TRUECOMM IN '" & SharedRoot & "\02_Engines\1EXP_YR\SABRS.accdb';"
        strSQL2 = "SELECT * FROM tbl_SOF_TRUECOMM IN '" & SharedRoot & "\02_Engines\2EXP_YR\SABRS.accdb';"

                    Call CreateExcel("Status of Funds_EndofMonth", strSavePath, strSQL, strPathtoTemplate, "PivotTable1", "MainCurrent", "Raw", _
                    "Raw1", "PivotTable2", "Main1EXP", strSQL1, "Raw2", "PivotTable3", "Main2EXP", strSQL2)
Else


                                strWHERE = GetBEA(AcquireUser)

    Select Case strWHERE

                                Case "ALL"

                                     strSQL = "SELECT VAL([FY FULL]) AS [FY FULL_], MRI, ARI, SRI, WCI, BEA, BESA, BSYM, SBHD, [FUND FUNC], BLI, [DIR BEA BESA RCVD BAL ITD AMT], " _
                                           & "[TrueComm], [OBL ITD AMT], [EXP ITD AMT], [LIQ ITD AMT], [UNCMT AMT], [UNOBL AMT], WCI_Desc, Organization " _
                                           & "FROM tbl_SOF_TrueComm;" 


                                Case "ZZ"

                                    MsgBox "Please see Admin to get access to section you are responsible for.", vbInformation, "Permission required"
                                    Exit Sub

                                Case Else

                                            strSQL = "SELECT VAL([FY FULL]) AS [FY FULL_], MRI, ARI, SRI, WCI, BEA, BESA, BSYM, SBHD, [FUND FUNC], BLI, [DIR BEA BESA RCVD BAL ITD AMT], " _
                                           & "[TrueComm], [OBL ITD AMT], [EXP ITD AMT], [LIQ ITD AMT], [UNCMT AMT], [UNOBL AMT], WCI_Desc, Organization " _
                                           & "FROM tbl_SOF_TrueComm " _
                                           & "WHERE BEA " & strWHERE & ";"

                                End Select

                                Call CreateExcel("Status of Funds", strSavePath, strSQL, strPathtoTemplate, "PivotTable1", "Main", "Raw")
End If



End Sub

Here is the CreateExcel routine referred to above

Sub CreateExcel(strRptTitle As String, strSavePath As String, Optional strQueryName As String, Optional strPathtoTemplate As String, Optional strPivotName As String, Optional strSheetName As String, Optional strRawSheetName As String, _
                                Optional strRawSheetName1 As String, Optional strPivotName1 As String, Optional strSheetName1 As String, Optional strQueryname1 As String, _
                                Optional strRawSheetName2 As String, Optional strPivotName2 As String, Optional strSheetName2 As String, Optional strQueryname2 As String)

'strQueryName = the query the raw data is sourced from
'strRptTitle = the name of the file after it is generated
'strPathtoTemplate = the directions to the template file for the excel
'strSavePath = the final save location of the completed excel file
'strPivotName = the title of the pivot table to refresh
'strSheetname = the title of the sheet where the pivot is

'any optional variable ending in a number (e.g, strSheetName2) refers to when an excel needs to be created with multiple raw data sheets and pivot tables.
'It allows the routine to expand and be more flexible when necessary


'this routine was originally just used to add excel files to KPI emails, now we call it from Form Choose and use it to generate email reports

Dim xlApp As Object
Dim WB As Object
Dim xlSheet As Object
Dim xlSheet1 As Object
Dim intCOL As Integer
Dim rs As DAO.Recordset
Dim fld As Variant
Dim db As DAO.Database
Dim pt As PivotTable

Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set WB = xlApp.Workbooks.Open(strPathtoTemplate)

xlApp.Visible = False

'Generates the initial sheet, query, etc
                Set xlSheet = WB.Sheets(strRawSheetName)
                Set rs = db.OpenRecordset(strQueryName)

                'PLACE
                intCOL = 1
                For Each fld In rs.Fields
                                        xlSheet.Cells(1, intCOL).Value = fld.Name
                                            intCOL = intCOL + 1
                                            Next
                With xlSheet
                .Rows("2:" & xlSheet.Rows.Count).ClearContents
                .Range("A2").CopyFromRecordset rs
                .Cells.EntireColumn.AutoFit
                End With
                Set xlSheet = WB.Sheets(strSheetName)
                       'we could set the template to refresh on opening, but it won't refresh if someone uses outlook previewer. Better to make the excel file refresh before it ever gets sent.
                        Set pt = xlSheet.PivotTables(strPivotName)
                        pt.RefreshTable

'If a second sheet and query needs to be created, then:
'The first part of this If statement checks to see if the optional variable has been provided
'If it hasn't been provided (denoted by whether strRawSheetName1 is = to nothing) then do nothing because the place it's called from doesn't require a second sheet
'If it has been provided, then place the raw data from the query and autofit everything

    If strRawSheetName1 = "" Then
    Else
            Set xlSheet = WB.Sheets(strRawSheetName1)
                Set rs = db.OpenRecordset(strQueryname1)
                'PLACE
                intCOL = 1
                For Each fld In rs.Fields
                                        xlSheet.Cells(1, intCOL).Value = fld.Name
                                            intCOL = intCOL + 1
                                            Next
                With xlSheet
                .Rows("2:" & xlSheet.Rows.Count).ClearContents
                .Range("A2").CopyFromRecordset rs
                .Cells.EntireColumn.AutoFit
                End With

                Set xlSheet = WB.Sheets(strSheetName1)
                       'we could set the template to refresh on opening, but it won't refresh if someone uses outlook previewer. Better to make the excel file refresh before it ever gets sent.
                        Set pt = xlSheet.PivotTables(strPivotName1)
                        pt.RefreshTable
    End If

'If a third sheet and query needs to be created, then:

    If strRawSheetName2 = "" Then
    Else
            Set xlSheet = WB.Sheets(strRawSheetName2)
                Set rs = db.OpenRecordset(strQueryname2)
                'PLACE
                intCOL = 1
                For Each fld In rs.Fields
                                        xlSheet.Cells(1, intCOL).Value = fld.Name
                                            intCOL = intCOL + 1
                                            Next
                With xlSheet
                .Rows("2:" & xlSheet.Rows.Count).ClearContents
                .Range("A2").CopyFromRecordset rs
                .Cells.EntireColumn.AutoFit
                End With

                Set xlSheet = WB.Sheets(strSheetName2)
                       'we could set the template to refresh on opening, but it won't refresh if someone uses outlook previewer. Better to make the excel file refresh before it ever gets sent.
                        Set pt = xlSheet.PivotTables(strPivotName2)
                        pt.RefreshTable
    End If



'cleanup

        WB.SaveCopyAs strSavePath
        WB.Close SaveChanges:=False

Set xlSheet = Nothing
Set pt = Nothing
Set rs = Nothing
Set WB = Nothing
Set xlApp = Nothing
Set db = Nothing

End Sub

Answer 1

(Sorry if my idea is stupid).

May-be is it related to a recent update of Windows or Office, so that the variable "strPathToTemplate" would become an internal or system variable name (for MS Word specificly), generating ambiguity with "Open" objet. Could you test just changing the name of that variable ?

(In fact, I hope this will not be the solution...).

Pierre.

Answer 2

I had similar issue and since than I use this snipped to open Excel (note the comma in GetObject):

'Start Excel
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
    Err.Clear
    On Error GoTo Error_Handler
    Set oExcel = CreateObject("Excel.Application")
    bExcelOpened = False
Else    'Excel was already running
    bExcelOpened = True
End If
On Error GoTo Error_Handler