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