我的第一个建议是检查自动运行的 Excel 加载项 - 尤其是公司安全文档分类/版权声明脚本。
您的下一个嫌疑人是Trusted Locations,我在Trusted Locations: a source of misleading error messages 标题下已经提到过。
这是主要嫌疑人,因为“受信任的位置”是一种安全设置,可以阻止脚本和自动化 COM 对象,但不能阻止手动操作。或者至少,不是所有“用户存在”手动操作。因此,您不会通过尝试手动重现错误来捕获它 - 您可能会发现您的调试尝试给出了不一致的结果。
您可以在任何 Microsoft Office 应用程序中,在“文件”菜单下作为选项手动将文件夹设置为受信任位置;信托中心;受信任的位置 - 但这是特定于用户的,您可能无法为运行您的应用程序的任何人(或其他人)执行此操作。所以这应该给你一个关于自动化它的提示:
设置可信位置的 VBA 代码:
Public Sub TrustThisFolder(Optional FolderPath As String, _
Optional TrustSubfolders As Boolean = True, _
Optional TrustNetworkFolders As Boolean = False, _
Optional sDescription As String)
' Add a folder to the 'Trusted Locations' list so that your project's VBA can
' open Excel files without raising errors like "Office has detected a problem
' with this file. To help protect your computer this file cannot be opened."
' Ths function has been implemented to fail silently on error: if you suspect
' that users don't have permission to assign 'Trusted Location' status in all
' locations, reformulate this as a function returning True or False
' This should be used with caution: although I regard Microsoft's rationale
' for 'Trusted Locations' to be flawed (in this specific case, perverse and
' worse than ineffective) bypassing a security feature is never a good idea
' without letting the users know what they are doing, and offering a choice
' You are strongly advised to keep the confirmation dialogue, unless you've
' run into something stupid - like refusing to open files in the user's own
' local temp folder - which is what we're dealing with here, in basExcelSQL
' Author:
' Nigel Heffernan January 2015 http:\Excellerando.blogspot.com
'
' Based on code published by Daniel Pineault in DevHut.net on June 23, 2010:
' www.devhut.net\2010\06\23\vbscript-createset-trusted-location-using-vbscript\
' **** **** **** **** THIS CODE IS IN THE PUBLIC DOMAIN **** **** **** ****
' This code has been widely published, and at least one of the sites carrying
' it (and derived works) asserts that it is subject to an open-source license,
' which explicitly forbids us from asserting ownership, copyright, or other
' intellectual property rights, or attempting to impose restrictive commercial
' secrecy terms on its use, re-use, or publication. Take care to label this
' this code, and segregate it from proprietary source code, or other material
' with embedded business process information which should be kept private.
' UNIT TESTING:
'
' 1: Reinstate the commented-out line 'Debug.Print sSubKey & vbTab & sPath
' 2: Open the Immediate Window and run this command:
' TrustThisFolder "Z:\", True, True, "The user's home directory"
' 3: If "Z:\" is already in the list, choose another folder
' 4: Repeat step 2 or 3: the folder should be listed in the debug output
' 5: If it isn't listed, disable the error-handler and record any errors
On Error GoTo ErrSub
Dim sKeyPath As String
Dim oRegistry As Object
Dim sSubKey As String
Dim oSubKeys ' type not specified. After it's populated, it can be iterated
Dim oSubKey ' type not specified.
Dim bSubFolders As Boolean
Dim bNetworkLocation As Boolean
Dim iTrustNetwork As Long
Dim bTempFolder As Long
Dim sMsg As String
Dim sPath As String
Dim sDate As String
Dim sDesc As String
Dim i As Long
Const HKEY_CURRENT_USER = &H80000001
bSubFolders = True
bNetworkLocation = False
If FolderPath = "" Then
FolderPath = FSO.GetSpecialFolder(2).Path
If sDescription = "" Then
sDescription = "The user's local temp folder"
End If
bTempFolder = True
End If
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
sKeyPath = ""
sKeyPath = sKeyPath & "SOFTWARE\Microsoft\Office\"
sKeyPath = sKeyPath & Application.Version
sKeyPath = sKeyPath & "\Excel\Security\Trusted Locations\"
Set oRegistry = GetObject("winmgmts:\.\root\default:StdRegProv")
' Note: not the usual \root\cimv2 for WMI scripting: the StdRegProv isn't in that folder
oRegistry.EnumKey HKEY_CURRENT_USER, sKeyPath, oSubKeys
For Each oSubKey In oSubKeys
sSubKey = CStr(oSubKey)
oRegistry.GetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Path", sPath
'Debug.Print sSubKey & vbTab & sPath
If sPath = FolderPath Then
Exit For
End If
Next oSubKey
If sPath <> FolderPath Then
If bTempFolder = False Then
sMsg = ""
sMsg = sMsg & "Microsoft Office will not allow " & APP_NAME & " to open files from this location: "
sMsg = sMsg & vbCrLf & vbCrLf
sMsg = sMsg & vbTab & "'" & FolderPath & "'"
sMsg = sMsg & vbCrLf & vbCrLf
sMsg = sMsg & "Would you like to add this folder to Microsoft Office's list or Trusted Locations?"
Select Case MsgBox(sMsg, vbQuestion + vbYesNo, APP_NAME & ": do you trust files from this location?")
Case vbYes
' continue
Case Else ' Else captures cancel actions as well as an explicit 'No'
Err.Raise -559038737, APP_NAME & ": TrustThisFolder", "user chose not to add folder to 'Trusted Locations'"
Exit Sub ' This is dead code ...unless error-handling is bypassed. One day, you'll thank me for this.
End Select
End If
If IsNumeric(Replace(sSubKey, "Location", "")) Then
i = CLng(Replace(sSubKey, "Location", "")) + 1
Else
i = UBound(oSubKeys) + 1
End If
sSubKey = "Location" & CStr(i)
If TrustNetworkFolders Then
iTrustNetwork = 1
oRegistry.GetDWordValue HKEY_CURRENT_USER, sKeyPath, "AllowNetworkLocations", iTrustNetwork
If iTrustNetwork = 0 Then
oRegistry.SetDWordValue HKEY_CURRENT_USER, sKeyPath, "AllowNetworkLocations", 1
End If
End If
oRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey
oRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Path", FolderPath
oRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Description", sDescription
oRegistry.SetDWordValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "AllowSubFolders", 1
MsgPopup "Successfully added '" & FolderPath & "' to the Microsoft Office Trusted Folders list.", vbInformation, APP_NAME & ": Action confirmed.", 3
End If
ExitSub:
Set oRegistry = Nothing
Exit Sub
ErrSub:
Resume ExitSub
End Sub
请注意,此代码取决于用户干预以确认删除“受信任的位置”设置。您可以删除对话,但我建议您在这样做之前咨询您的系统管理员。
(注意:我使用的是“弹出”对话框,它会在预设时间间隔后自动消失,让代码继续。询问您是否需要代码)
之后,它变得神秘。这是我上次不得不使用 Excel.exe 的单独实例打开文件时编写的代码:
With New Excel.Application
.ShowStartupDialog = False
.Visible = False
.EnableCancelKey = xlDisabled
.UserControl = False
.Interactive = False
.EnableEvents = False
.DisplayAlerts = False
.AutomationSecurity = msoAutomationSecurityForceDisable
.Workbooks.Add ' Calculation property is not available if no workbooks are open
If .Calculation <> xlCalculationManual Then
.Calculation = xlCalculationManual
End If
On Error Resume Next
For i = .Workbooks.Count To 1 Step -1
.Workbooks(i).Close False
Next i
On Error Resume Next
For i = 1 To .AddIns.Count
If .AddIns(i).IsOpen Then
.AddIns(i).Installed = False
End If
Next i
For i = 1 To .COMAddIns.Count
If .COMAddIns(1).progID Like "*Information*Classification*" Then
' no action
Else
.COMAddIns(i).Connect = False
If Not .COMAddIns(i).Object Is Nothing Then
.COMAddIns(i).Object.Close
.COMAddIns(i).Object.Quit
End If
End If
Next i
End With
您会注意到其中的'On error Resume Next':某些加载项无法关闭。
之后是月相和人祭。或者,也许可以快速查看 Stack Oveflow 上的其他答案。