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

问题描述

我有几个 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 报告的约定，即使我称它们为 Template***，也与 normal.dotm 无关。我不禁认为这个 IT 帮助台引入了一个不同的问题。

我尝试过的事情：
1. 释放更多共享驱动器空间
2. 从共享驱动器中删除所有临时文件实例
3. 在 Access 上压缩和修复
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

标签： excelvbams-accessms-word

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

问题描述

解决方案

推荐阅读