Microsoft Access 例程生成的 Excel 報告出現錯誤 1004：方法打開對象工作簿失敗

Question

我有幾個 Excel 報告報告，它們是通過 MS Access 數據庫應用程序上的按鈕按需啟動的。 發布這些報告的例行程序多年來一直運行良好，沒有出現任何問題，直到上周我們的共享驅動器達到存儲容量為止。

請注意，我使用現成的 Excel 工作簿的約定，該工作簿具有生成最終報告的大部分格式，並通過使用帶有 Excel 對象庫的 VBA 將數據添加到其中來構建我的最終報告。 我稱這些“模板”不與 Microsoft Word 模板約定有任何關聯。 為避免混淆，我將在整個描述中將此約定的引用標記為模板***

由於 IT 團隊在此處釋放了共享驅動器空間，因此錯誤已顯着減少，但對於大約 30% 的用戶，在啟動 excel 下載時仍返回以下錯誤：“錯誤 1004：方法打開對象工作簿失敗” .
出現錯誤的代碼行以前從未出現過問題：

Set WB = xlApp.Workbooks.Open(strPathToTemplate)

其中 strPathToTemplate 是保存 excel Template*** 的共享驅動器路徑。

在與我們的 IT 進行多次通話后，一位幫助台人員應用了以下解決方案：導航至，找到名為“Normal.dotm”的 Microsoft 啟用宏的 Word 模板文件，並將其重命名為“Old.Normal.dotm”。 這立即恢復了從儀表板下載 excel 報告的功能。 幫助台人員無法/不會解釋他們如何知道這是問題或為什么它會影響 excel 下載。 現在的問題是，雖然這個解決方案適用於我應用它的每個用戶，但它也是暫時的。 每次用戶重新啟動時，normal.dotm 文件都會自行恢復，必須再次重命名，否則儀表板中將再次出現 1004 錯誤。

我已經給幫助台打了電話，但沒有得到進一步的解釋或更持久的解決方案。

我最大的問題（除了如何永久解決這個問題）是為什么這個 MS Word normal.dotm 文件對從 MS Access 數據庫啟動的 excel 文件有任何影響？ 我們在編程中引用此漫游模板文件路徑的情況為零，而且我們根本不使用 Word。 我可以在網上找到很多關於 normal.dotm 文件如何在 Word 中引起問題的信息，但沒有關於它如何影響除 Word 之外的其他 Microsoft 應用程序的信息。

同樣，我用來生成 Excel 報告的約定即使我稱它們為模板***也與 normal.dotm 無關。 我不禁想到這個 IT 服務台引入了一個不同的問題。

我嘗試過的事情：
1.釋放更多共享驅動空間
2. 從共享驅動器中刪除所有臨時文件實例
3. 訪問的壓縮和修復
4.使用新的excel模板***文件
5. excel模板重寫路徑***
6. 確保 MS Word 中沒有個人宏
7. 重寫創建excel報表的程序，進行早期綁定而不是后期綁定
8、在不同電腦上多次重啟，證明是恢復normal.dotm文件導致儀表盤返回錯誤
9、在其他用戶的電腦上測試dotm文件重命名解決方案。

我提供了盡可能多的 vba 代碼，這些代碼可能在下面有問題

這是啟動我們的資金狀況報告的主要 vba，我使用格式化的 Excel 工作簿模板***通過將其與數據“結合”來生成報告。

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

這里是上面提到的CreateExcel例程

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

（對不起，如果我的想法很愚蠢）。

可能與 Windows 或 Office 的最近更新有關，因此變量“strPathToTemplate”將成為內部或系統變量名稱（特別是對於 MS Word），從而與“打開”對象產生歧義。 你能測試一下改變那個變量的名字嗎？

（事實上​​，我希望這不是解決方案......）。

皮埃爾。

Answer 2

我有類似的問題，因為我使用這個剪斷來打開 Excel（注意 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