MS Access 2010，Excel 2010，Windows Server 2008 R2 64位：工作簿类的SaveAs方法失败

Question

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

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

objxl.ActiveWorkbook.SaveAs filename, FileFormat:=xlOpenXMLWorkbook

和

xlWBk.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 ）。

我们已根据这篇文章尝试了修复：https://stackoverflow.com/a/1090864/5239568

但到目前为止似乎没有任何工作。

Answer 1

最后修好了。这是有效的，以防将来任何人都有同样的错误。

我们添加了两个文件夹：

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

Answer 2

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

您的下一个嫌疑人是受信任的地点，我在其他地方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上的其他答案。