VBA调用SaveAs报错1004：OneDrive同步桌面文件夹未就绪即保存文件问题

核心修改思路 #

• 在创建文件夹后增加轮询检测逻辑，确认文件夹完全可访问后再执行保存操作，同时兼容文件夹已存在的场景，避免额外报错
• 增加重试上限，避免极端同步故障导致代码无限卡死

完整可运行代码 #

Sub TestSave()
    Dim wb As Workbook
    Dim desktopPath As String
    Dim folderPath As String
    Dim filePath As String
    Dim waitCount As Integer
    Const MAX_WAIT_SECONDS As Integer = 10 ' 最长等待10秒，可自行调整
    
    ' 预获取路径，避免重复调用COM对象
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    folderPath = desktopPath & "Test_Folder"
    filePath = folderPath & "\Test_File.xlsx"
    
    Application.DisplayAlerts = False
    
    ' 文件夹不存在则创建
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
        ' 轮询等待文件夹就绪
        waitCount = 0
        Do While Dir(folderPath, vbDirectory) = "" And waitCount < MAX_WAIT_SECONDS * 10
            Application.Wait Now + TimeValue("00:00:01") / 10 ' 每次等待100毫秒
            waitCount = waitCount + 1
        Loop
    End If
    
    ' 确认文件夹就绪后再执行保存
    If Dir(folderPath, vbDirectory) <> "" Then
        Set wb = Workbooks.Add
        wb.SaveAs Filename:=filePath
        wb.Close SaveChanges:=False
    Else
        MsgBox "文件夹创建超时，请检查OneDrive同步状态", vbExclamation
    End If
    
    Application.DisplayAlerts = True
End Sub

关键逻辑说明 #

• 预存储路径变量：避免多次调用WScript.Shell接口，减少不必要的性能开销
• 前置文件夹存在校验：如果文件夹已存在就跳过创建步骤，避免MkDir重复创建抛出错误
• 轮询检测机制：创建文件夹后每100毫秒检查一次文件夹是否可被系统识别，最长等待时间可通过MAX_WAIT_SECONDS常量自定义，适配不同同步速度的OneDrive环境
• 异常提示：如果超过等待时间文件夹仍未就绪，会弹出提示避免无响应

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