Vba MS Access 2010、Excel 2010、Windows Server 2008 R2 64位：工作簿类的另存为方法失败

使用的服务：MS Access 2010、Excel 2010、Windows Server 2008 R2（64位）

在MS Access数据库中，我们编写了一个将查询导出为.xlsx格式并保存在网络驱动器上的过程。它使用以下语法：

objxl.ActiveWorkbook.SaveAs filename, FileFormat:=xlOpenXMLWorkbook

及

其中，objxl声明为：

Private objxl As Object

文件通过以下方式打开：

Dim xlWBk As Object

If objxl Is Nothing Then
    Set objxl = CreateObject("Excel.Application")
End If

If Dir(sourceFile) = vbNullString Then
    Set xlWBk = objxl.Workbooks.Add
Else
    Set xlWBk = objxl.Workbooks.Open(sourceFile)
    blnFileExists = True
End If

当我们手动运行此代码时，它工作正常。我有理由相信代码是正确的，但我在这里发布它只是以防万一

但是，我们需要自动化此数据库，以便通过计划任务从帐户运行它，设置为即使帐户未登录也运行（并且此帐户具有管理员权限等）。不幸的是，像这样运行程序时，我们的日志中会出现以下错误：

"SaveAs method of Workbook class failed."

我们已验证这不是网络读/写问题（它可以将各种其他文件（如.txt和.pdf）写入网络驱动器。此问题似乎已本地化为Excel）

我们已尝试根据此帖子进行修复：

---

但到目前为止似乎没有任何效果。

我的第一个建议是检查自动运行的Excel加载项，尤其是公司安全文档分类/版权通知脚本

你的下一个嫌疑犯是受信任的地点，我在标题下的其他地方提到过

这是最主要的嫌疑犯，因为“可信位置”是一种安全设置，可以阻止脚本和自动COM对象，但不能阻止手动操作。或者至少，不是所有的“用户在场”手动操作。因此，您无法通过手动复制错误来捕获错误，并且您可能会发现调试尝试会产生不一致的结果

您可以在任何Microsoft Office应用程序中，将“文件”菜单下的文件夹作为选项手动设置为受信任的位置；信托中心；受信任的位置-但这是特定于用户的，您可能无法为运行应用程序的任何人（或任何人）执行此操作。因此，这应该给您一个关于自动化的提示：

设置受信任位置的VBA代码：

PublicSubTrustThisFolder（可选FolderPathAsString_ OptionalTrustSubfoldersAsBoolean=True_ OptionalTrustNetworkFoldersAsBoolean=False_ 可选说明字符串）
'将文件夹添加到'Trusted Locations'列表中，以便您的项目可以 “OpenExcelf”未出现类似“Office”的错误，但已检测到问题 “使用此文件。要帮助保护您的计算机，无法打开此文件。”
'此函数已被执行为默认错误：ifyoususpect 'thatusersdon'thavePermissions分配'TrustedLocation'状态所有 '位置，重新格式化IsasaFunctionReturningTrue或False

这一点应该谨慎使用：尽管微软的立场是错误的 对于“受信任的地点”而言，应遵守法律（在本特定案例中，为倒行逆施） “WORSETHAN无效）绕过安全功能不是一个好主意 '不让用户知道发生了什么，并提供了一个选择
你强烈建议接受确认对话，除非你 “runintosomethingstupid-like融合到用户中的开放文件” “localtempfolder-whichiswhatwe”在BaseXcelSQL中重新对齐 '作者：
“NigelHeffernanJanuary2015http:\Excellerando.blogspot.com
” 'BasedoncodepublishedbyDanielPineaultinDevHut.neton 2013年6月2日： “www.devhut.net\2010\06\23\vbscript使用vbscript创建受信任位置\
“**********************此代码位于公开领域************************
“这段代码已经公开发表了，而且令人震惊 “it（和DerivedWorks）断言它受任何源许可证的约束， “它明确表示不主张所有权、版权或其他 “知识产权权利、演讲吸引着重要的商业活动 “secrecytermsonitsuse，重复使用，或发布。小心 “此代码，并将其与Orothermal专有资源代码隔离 '带有嵌入的业务流程信息，该信息应为私有。

“单元测试：
” '1:恢复Commented-outline'Debug.printsubkey&vbTab&sPath '2:打开即时窗口并运行此命令： 'TrustThisFolder“Z:\”，True，True，“用户的shomedidirectory” '3:如果“Z:\”已在列表中显示，请选择其他文件夹 '4:重复步骤2或3:文件夹应在Debug输出中删除 '5:如果列出，则禁用错误句柄并记录任何错误

OnErrorGoToErrSub

DIMSKEYPATHSTRING
DimoRegistryAsObject DimsSubKeyAsString 未指定DimoSubKeys的类型。填充后，可以将其删除 未指定DimoSubKey’类型。
DimbSubFoldersAsBoolean DimbNetworkLocationAsBoolean
尽可能长的信任网络 DimbTempFolderAsLong
DimsMsgAsString DIMSPAthastring DIMSDATEASTRING DimsDescAsString 迪米阿斯隆
ConstHKEY_当前_用户=&H80000001
bSubFolders=True bNetworkLocation=False
IfFolderPath=”“然后
FolderPath=FSO.GetSpecialFolder（2.Path） IfsDescription=”“然后 sddescription=“用户的slocaltempfolder” EndIf
bTempFolder=True
EndIf
IfRight（FolderPath，1）<&燃气轮机；“\”然后 FolderPath=FolderPath&“\” EndIf

sKeyPath=“” sKeyPath=sKeyPath&“软件\Microsoft\Office” sKeyPath=sKeyPath&Application.Version sKeyPath=sKeyPath&“\Excel\Security\TrustedLocations\”

SetoRegistry=GetObject（“winmgmts:\。\root\default:StdRegProv”） '注意：不是通常的\root\cimv2说明：ThestDregProvisin'tinthatfolder
oRegistry.EnumKeyHKEY\u当前用户、sKeyPath、oSubKeys

foreachosubkeyinosubkey
sSubKey=CStr（oSubKey） oRegistry.GetStringValueHKEY\u当前用户，sKeyPath&“\”&sSubKey，“Path”，sPath
'Debug.printsubkey&vbTab&sPath
IfsPath=FolderPathThen 出口 EndIf
NextoSubKey
IfsPath<&燃气轮机；FolderPathThen
IfbTempFolder=false然后 sMsg=“” sMsg=sMsg&“MicrosoftOfficewillnotallow”&APP_NAME&“toopenfilesfromthislocation:” sMsg=sMsg&vbCrLf&vbCrLf sMsg=sMsg&vbTab&“'”和FolderPath&“” sMsg=sMsg&vbCrLf&vbCrLf sMsg=sMsg&“您愿意将此文件夹添加到Microsoft Office的存储信任位置吗？”
选择casemsg

"SaveAs method of Workbook class failed."

PublicSubTrustThisFolder(OptionalFolderPathAsString,_ OptionalTrustSubfoldersAsBoolean=True,_ OptionalTrustNetworkFoldersAsBoolean=False,_ OptionalsDescriptionAsString)
'Addafoldertothe'TrustedLocations'listsothatyourproject'sVBAcan 'openExcelfileswithoutraisingerrorslike"Officehasdetectedaproblem 'withthisfile.Tohelpprotectyourcomputerthisfilecannotbeopened."
'Thsfunctionhasbeenimplementedtofailsilentlyonerror:ifyoususpect 'thatusersdon'thavepermissiontoassign'TrustedLocation'statusinall 'locations,reformulatethisasafunctionreturningTrueorFalse

'Thisshouldbeusedwithcaution:althoughIregardMicrosoft'srationale 'for'TrustedLocations'tobeflawed(inthisspecificcase,perverseand 'worsethanineffective)bypassingasecurityfeatureisneveragoodidea 'withoutlettingtheusersknowwhattheyaredoing,andofferingachoice
'Youarestronglyadvisedtokeeptheconfirmationdialogue,unlessyou've 'runintosomethingstupid-likerefusingtoopenfilesintheuser'sown 'localtempfolder-whichiswhatwe'redealingwithhere,inbasExcelSQL

'Author:
'NigelHeffernanJanuary2015http:\Excellerando.blogspot.com
' 'BasedoncodepublishedbyDanielPineaultinDevHut.netonJune23,2010: 'www.devhut.net\2010\06\23\vbscript-createset-trusted-location-using-vbscript\
'****************THISCODEISINTHEPUBLICDOMAIN****************
'Thiscodehasbeenwidelypublished,andatleastoneofthesitescarrying 'it(andderivedworks)assertsthatitissubjecttoanopen-sourcelicense, 'whichexplicitlyforbidsusfromassertingownership,copyright,orother 'intellectualpropertyrights,orattemptingtoimposerestrictivecommercial 'secrecytermsonitsuse,re-use,orpublication.Takecaretolabelthis 'thiscode,andsegregateitfromproprietarysourcecode,orothermaterial 'withembeddedbusinessprocessinformationwhichshouldbekeptprivate.

'UNITTESTING:
' '1:Reinstatethecommented-outline'Debug.PrintsSubKey&vbTab&sPath '2:OpentheImmediateWindowandrunthiscommand: 'TrustThisFolder"Z:\",True,True,"Theuser'shomedirectory" '3:If"Z:\"isalreadyinthelist,chooseanotherfolder '4:Repeatstep2or3:thefoldershouldbelistedinthedebugoutput '5:Ifitisn'tlisted,disabletheerror-handlerandrecordanyerrors

OnErrorGoToErrSub

DimsKeyPathAsString
DimoRegistryAsObject DimsSubKeyAsString DimoSubKeys'typenotspecified.Afterit'spopulated,itcanbeiterated DimoSubKey'typenotspecified.
DimbSubFoldersAsBoolean DimbNetworkLocationAsBoolean
DimiTrustNetworkAsLong DimbTempFolderAsLong
DimsMsgAsString DimsPathAsString DimsDateAsString DimsDescAsString DimiAsLong
ConstHKEY_CURRENT_USER=&H80000001
bSubFolders=True bNetworkLocation=False
IfFolderPath=""Then
FolderPath=FSO.GetSpecialFolder(2).Path IfsDescription=""Then sDescription="Theuser'slocaltempfolder" EndIf
bTempFolder=True
EndIf
IfRight(FolderPath,1)<>"\"Then FolderPath=FolderPath&"\" EndIf

sKeyPath="" sKeyPath=sKeyPath&"SOFTWARE\Microsoft\Office\" sKeyPath=sKeyPath&Application.Version sKeyPath=sKeyPath&"\Excel\Security\TrustedLocations\"

SetoRegistry=GetObject("winmgmts:\.\root\default:StdRegProv") 'Note:nottheusual\root\cimv2forWMIscripting:theStdRegProvisn'tinthatfolder
oRegistry.EnumKeyHKEY_CURRENT_USER,sKeyPath,oSubKeys

ForEachoSubKeyInoSubKeys
sSubKey=CStr(oSubKey) oRegistry.GetStringValueHKEY_CURRENT_USER,sKeyPath&"\"&sSubKey,"Path",sPath
'Debug.PrintsSubKey&vbTab&sPath
IfsPath=FolderPathThen ExitFor EndIf
NextoSubKey
IfsPath<>FolderPathThen
IfbTempFolder=FalseThen sMsg="" sMsg=sMsg&"MicrosoftOfficewillnotallow"&APP_NAME&"toopenfilesfromthislocation:" sMsg=sMsg&vbCrLf&vbCrLf sMsg=sMsg&vbTab&"'"&FolderPath&"'" sMsg=sMsg&vbCrLf&vbCrLf sMsg=sMsg&"WouldyouliketoaddthisfoldertoMicrosoftOffice'slistorTrustedLocations?"
SelectCaseMsgBox(sMsg,vbQuestion+vbYesNo,APP_NAME&":doyoutrustfilesfromthislocation?") CasevbYes 'continue CaseElse'Elsecapturescancelactionsaswellasanexplicit'No' Err.Raise-559038737,APP_NAME&":TrustThisFolder","userchosenottoaddfolderto'TrustedLocations'" ExitSub'Thisisdeadcode...unlesserror-handlingisbypassed.Oneday,you'llthankmeforthis. EndSelect EndIf
IfIsNumeric(Replace(sSubKey,"Location",""))Then i=CLng(Replace(sSubKey,"Location",""))+1 Else i=UBound(oSubKeys)+1 EndIf
sSubKey="Location"&CStr(i)
IfTrustNetworkFoldersThen iTrustNetwork=1 oRegistry.GetDWordValueHKEY_CURRENT_USER,sKeyPath,"AllowNetworkLocations",iTrustNetwork IfiTrustNetwork=0Then oRegistry.SetDWordValueHKEY_CURRENT_USER,sKeyPath,"AllowNetworkLocations",1 EndIf EndIf
oRegistry.CreateKeyHKEY_CURRENT_USER,sKeyPath&"\"&sSubKey oRegistry.SetStringValueHKEY_CURRENT_USER,sKeyPath&"\"&sSubKey,"Path",FolderPath oRegistry.SetStringValueHKEY_CURRENT_USER,sKeyPath&"\"&sSubKey,"Description",sDescription oRegistry.SetDWordValueHKEY_CURRENT_USER,sKeyPath&"\"&sSubKey,"AllowSubFolders",1
MsgPopup"Successfullyadded'"&FolderPath&"'totheMicrosoftOfficeTrustedFolderslist.",vbInformation,APP_NAME&":Actionconfirmed.",3
EndIf

ExitSub:
SetoRegistry=Nothing ExitSub
ErrSub:
ResumeExitSub
EndSub
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

C:\Windows\System32\config\systemprofile\Desktop
C:\Windows\SysWOW64\config\systemprofile\Desktop