Excel VBA导出PDF到双路径时1004/76运行错误解决方案

问题根因分析 #

两类报错属于VBA导出PDF的典型场景问题，和路径执行顺序、代码书写位置无关，核心触发原因如下：

• Run-Time error '1004': Application-defined or object defined error：ExportAsFixedFormat方法执行时会锁定导出目标的文件句柄，同时生成临时缓存文件，连续两次直接调用该方法导出同一张工作表内容时，第二次调用会因为前一次IO资源未完全释放、临时缓存冲突触发报错，这也是调换路径执行顺序后始终只有第一个导出动作成功的核心原因。
• Run-Time error '76': Path not found：原生FSO.CreateFolder方法不支持递归创建多级目录，如果目标路径包含多层不存在的上级目录（比如路径下的年份文件夹、业务分类文件夹未提前创建），直接调用该方法创建最下层目录就会触发报错；另外硬编码拼接路径时多写/漏写路径分隔符\、桌面路径被组策略重定向，也会触发该错误。

可直接复用的修复代码 #

代码采用晚绑定写法，不需要手动添加脚本运行时引用，可直接替换原有逻辑：

Const EXPORT_RANGE As String = "A1:K91"
Const PDF_NAME As String = "Form业务表单.pdf" ' 可按需修改为动态命名规则，比如拼接日期、单据号

Sub gpSaveSend()
    Dim ws As Worksheet
    Dim tempPdfPath As String, oneDriveDesktop As String, localDesktop As String
    Dim fso As Object
    Dim targetPaths(1 To 2) As String
    Dim i As Integer
    
    ' 初始化基础对象
    Set ws = ThisWorkbook.Worksheets("Form")
    Set fso = CreateObject("Scripting.FileSystemObject")
    tempPdfPath = Environ("TEMP") & "\" & PDF_NAME ' 首次导出到系统临时目录
    
    ' 动态获取两类桌面路径，避免硬编码适配问题
    oneDriveDesktop = GetOneDriveDesktopPath()
    localDesktop = GetLocalDesktopPath()
    targetPaths(1) = oneDriveDesktop
    targetPaths(2) = localDesktop
    
    ' 递归检查所有目标路径，不存在则自动创建
    For i = 1 To 2
        If targetPaths(i) <> "" Then Call CreateFullPath(targetPaths(i), fso)
    Next
    
    ' 仅执行一次PDF导出，从根源规避连续导出的1004错误
    ws.Range(EXPORT_RANGE).ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=tempPdfPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    ' 将临时导出的PDF复制到两个目标路径，自动覆盖同名旧文件
    For i = 1 To 2
        If targetPaths(i) <> "" And fso.FolderExists(targetPaths(i)) Then
            fso.CopyFile tempPdfPath, targetPaths(i) & "\" & PDF_NAME, True
        End If
    Next
    
    ' 清理临时文件
    If fso.FileExists(tempPdfPath) Then fso.DeleteFile tempPdfPath, True
    
    ' 原有Outlook自动发送逻辑可直接放在此处
    ' Call YourOriginalSendMailProcess
    
    Set fso = Nothing
    Set ws = Nothing
    MsgBox "PDF已成功保存到所有适配桌面路径", vbInformation
End Sub

' 递归创建多级目录，替代原有FolderCheck/YearFolderCheck函数，彻底解决76路径错误
Private Sub CreateFullPath(fullPath As String, fso As Object)
    Dim parentPath As String
    fullPath = fso.GetAbsolutePathName(fullPath)
    If fso.FolderExists(fullPath) Then Exit Sub
    parentPath = fso.GetParentFolderName(fullPath)
    If parentPath <> "" And Not fso.FolderExists(parentPath) Then Call CreateFullPath(parentPath, fso)
    fso.CreateFolder fullPath
End Sub

' 动态获取本地用户桌面路径，兼容组策略重定向场景
Private Function GetLocalDesktopPath() As String
    Dim wshShell As Object
    Set wshShell = CreateObject("WScript.Shell")
    GetLocalDesktopPath = wshShell.SpecialFolders("Desktop")
    Set wshShell = Nothing
End Function

' 动态获取OneDrive同步桌面路径，兼容商业版/个人版、不同租户的OneDrive配置
Private Function GetOneDriveDesktopPath() As String
    Dim oneDriveRoot As String
    Dim wshShell As Object, fso As Object
    Set wshShell = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    On Error Resume Next
    oneDriveRoot = wshShell.RegRead("HKEY_CURRENT_USER\Environment\OneDriveCommercial")
    If oneDriveRoot = "" Then oneDriveRoot = wshShell.RegRead("HKEY_CURRENT_USER\Environment\OneDriveConsumer")
    On Error GoTo 0
    
    If oneDriveRoot <> "" Then
        oneDriveRoot = oneDriveRoot & "\Desktop"
        If fso.FolderExists(oneDriveRoot) Then
            GetOneDriveDesktopPath = oneDriveRoot
            Exit Function
        End If
    End If
    ' 未检测到OneDrive同步桌面时返回空值，后续逻辑自动跳过该路径不报错
    GetOneDriveDesktopPath = ""
    Set fso = Nothing
    Set wshShell = Nothing
End Function

关键修复点说明 #

• 将原有两次ExportAsFixedFormat调用改为一次导出到临时目录+两次文件复制，从根源规避连续导出触发的文件句柄锁定、缓存冲突问题，导出速度比双次导出提升一倍。
• 替换原有分层级文件夹检查逻辑为递归多级目录创建函数，不管路径包含多少层未创建的上级目录，都能逐级自动生成，彻底解决76路径找不到错误，原代码中的FolderCheck、YearFolderCheck函数可直接废弃。
• 弃用硬编码路径写法，通过注册表、WScript特殊文件夹接口动态获取两类桌面路径，自动适配不同员工的系统配置、组策略重定向、OneDrive租户差异，不需要针对不同电脑手动修改路径。
• 增加路径有效性校验，如果员工电脑未配置OneDrive桌面同步，会自动跳过该路径的保存动作，不会抛出异常中断代码运行。

内容的提问来源于stack exchange，提问作者Mildred Puffinstuff