VBA保存PDF至共享OneDrive本地快捷方式遇1004运行时错误求助

问题核心 #

需将Excel工作表导出至当前工作簿所在目录下的Save文件夹（该目录属于OneDrive共享账户的本地同步快捷方式），遇到以下问题：

• 使用CurDir()拼接路径触发1004运行时错误
• 使用ActiveWorkbook.Path得到云端HTTPS路径，每次保存需登录验证，体验差
• 手动保存PDF正常，但录制的宏执行仍报错

问题原因 #

1. CurDir()返回的是VBA默认工作目录，并非工作簿实际所在的OneDrive本地同步目录，导致路径无效
2. 当工作簿存储在OneDrive同步目录时，ActiveWorkbook.Path会返回云端URL而非本地文件路径，触发登录验证

可行解决方案 #

方案1：从工作簿完整路径提取本地目录 #

利用ActiveWorkbook.FullName获取本地完整路径，移除文件名后拼接Save文件夹，确保得到本地同步路径而非云端URL：

Dim fso As Object
Dim workbookDir As String
Dim pdfPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
' 获取工作簿所在的本地目录
workbookDir = fso.GetParentFolderName(ActiveWorkbook.FullName)
' 拼接Save文件夹和PDF文件名
pdfPath = fso.BuildPath(workbookDir, "Save\" & sh01.Cells(rw2, 4).Value & " " & sh01.Cells(rw2, 5).Value & ".pdf")

' 导出PDF
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=pdfPath, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

Set fso = Nothing

方案2：读取注册表获取OneDrive本地同步路径 #

若方案1无效（部分OneDrive配置下FullName仍返回URL），可通过读取注册表获取当前用户的OneDrive共享文档本地路径：

Dim shell As Object
Dim oneDriveSharedPath As String
Dim pdfPath As String

Set shell = CreateObject("WScript.Shell")
' 读取OneDrive商业版共享文档的本地同步路径
On Error Resume Next
oneDriveSharedPath = shell.RegRead("HKCU\Software\Microsoft\OneDrive\Accounts\Business1\UserFolder") & "\Shared Documents\BI\Forms\Quality Assurance_Ventilation"
On Error GoTo 0

If oneDriveSharedPath <> "" Then
    ' 拼接Save文件夹和PDF文件名
    pdfPath = oneDriveSharedPath & "\Save\" & sh01.Cells(rw2, 4).Value & " " & sh01.Cells(rw2, 5).Value & ".pdf"
    
    ' 导出PDF
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=pdfPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
Else
    MsgBox "无法获取OneDrive本地同步路径，请检查OneDrive配置"
End If

Set shell = Nothing

方案3：提前验证并创建目标文件夹 #

在导出前检查Save文件夹是否存在，不存在则创建，避免因路径不存在触发1004错误：

Dim fso As Object
Dim saveFolder As String
Dim pdfPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
saveFolder = fso.GetParentFolderName(ActiveWorkbook.FullName) & "\Save"

' 检查Save文件夹是否存在，不存在则创建
If Not fso.FolderExists(saveFolder) Then
    fso.CreateFolder saveFolder
End If

pdfPath = saveFolder & "\" & sh01.Cells(rw2, 4).Value & " " & sh01.Cells(rw2, 5).Value & ".pdf"

' 导出PDF
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=pdfPath, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

Set fso = Nothing

关键注意事项 #

• 确保OneDrive处于同步状态，本地目录存在且有读写权限
• 避免使用相对路径或默认目录，始终基于工作簿实际本地路径拼接
• 用FileSystemObject处理路径可自动兼容不同系统的斜杠格式，减少路径错误

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