MS Access对Excel报告错误MS Access 2016-2147467259,80004005运行以前可靠的例程时出错

问题描述

我们的办公室已应用McAfee Anti-Virus的更新。它开始阻止某些Visual Basic参考库文件路径,并特别禁用启动Excel报告或在Excel中运行VBA的功能。每次用户单击报告按钮时,McAfee会将其记录为来自Excel中恶意代码的攻击,并停止报告。这样,我捕获错误的尝试是失败的,因为它只是关闭代码。为了使事情更加混乱,如果幸运的话,可以期望代码在一天中的某个时间运行。

当前解决方案:IT部门已经能够应用临时修订来解除对参考库文件夹路径的阻止,并使我们的仪表板重新工作。但是,Excel VBE7INTL.DLL库的确切Microsoft签名经常更新,并且McAfee在每次更新时都会再次捕获它。现在,IT部门正在向Microsoft提交票证,以确定为什么Microsoft对该库的签名不断变化,并确保我们拥有永久性的修复程序。

同时,我提供我的代码是为了查看我是否可以避免McAfee发现它的问题。 快速查看其工作原理。我存储了一个具有基本数据结构的Excel工作簿,其中有一个引用该数据的数据透视表。当我的例程运行时,它仅替换数据。数据透视表的结构保持不变。我只是将此新实例另存为用户文档文件夹中的已保存名称。请不要将“模板”一词用作“ xlts”。该解决方案没有利用该技术。该例程仅使用我提供的工作簿作为自己的模板来为用户生成报告实例。

Sub CreateGCPCWeekly(strPathtoTemplate As String)

On Error GoTo GCPCWeekly_err
Dim iTry As Integer
    
iTry = 0
Try:
    

    
Dim xlApp As Object
Dim WB As Object
Dim xlSheet As Object
Dim xlPvt As Object


Dim qdf As DAO.QueryDef
Dim intCOL As Integer

Dim intRecords As Integer


Dim rs As DAO.Recordset
Dim X As Integer
Dim fld As Variant




Dim strsql As String

Dim db As DAO.Database

PopupMsg_MC "Generating GCPC Weekly Pivot Table"

Set db = CurrentDb


Set xlApp = CreateObject("Excel.Application")
Set WB = xlApp.Workbooks.Open(strPathtoTemplate)
Set xlSheet = WB.Sheets("Raw")
Set xlPvt = WB.Sheets("Main")


xlApp.Visible = False

Set rs = db.OpenRecordset("qGCPCWeekly_LIQ")


intRecords = rs.RecordCount

xlSheet.Range("A2").CurrentRegion.ClearContents

'PLACE
intCOL = 1

For Each fld In rs.Fields
    xlSheet.Cells(1,intCOL).value = fld.Name
    intCOL = intCOL + 1
Next
    



With xlSheet
.Range("A2").copyFromrecordset rs
.Cells.EntireColumn.AutoFit
End With

xlPvt.Pivottables("Pivottable1").PivotCache.Refresh

'cleanup
Set xlSheet = nothing



Dim strPath As String
strPath = Environ$("UserProfile") & "\Documents\" & _
"GCPC Weekly Report as of " & DateString & ".xlsx"

WB.SavecopyAs strPath
WB.Close SaveChanges:=False

MsgBox "GCPC Weekly Report saved to Documents folder.",vbOKOnly + vbinformation,"Report Saved"

PresentExcel (strPath)

GoTo GCPCWeekly_Exit
GCPCWeekly_err:

Select Case Err.Number
'Attempt to try up to 5 times before exiting

    Case -2147467259,80004005

    Set rs = nothing
    Set qdf = nothing




    'MsgBox "Report Complete"
    Set xlApp = nothing
    Set WB = nothing
    Set xlSheet = nothing
    Set xlPvt = nothing


    iTry = iTry + 1

    If iTry <= 5 Then
        GoTo Try
    Else

        MsgBox "Routine is sporadically disabled by McAfee. Our IT Department says they are working on it.  Please try again later.",iTry & " tries"
        Resume GCPCWeekly_Exit
    End If


Case Else

    MsgBox Err.Number & "-" & Err.Description

End Select



GCPCWeekly_Exit:



Set rs = nothing
Set qdf = nothing

'MsgBox "Report Complete"
Set xlApp = nothing
Set WB = nothing
Set xlSheet = nothing
Set xlPvt = nothing

DoCmd.Close acForm,"Wait"


End Sub

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)