问题描述
我们的办公室已应用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 (将#修改为@)