Excel VBA中用Windows API模拟保存时指定路径不生效问题

你遇到的核心问题是仅修改了「另存为」对话框的文件名输入框文本，但未触发对话框内部的路径切换逻辑——输入框显示路径只是视觉效果，对话框的当前工作目录仍为默认值，因此保存时会沿用默认路径。

方案1：设置路径后触发确认（简单有效） #

在输入框写入路径后，发送回车键让对话框解析并切换到目标目录，再执行保存操作：

修改你的Sample子过程：

Sub Sample(sPic As String)
    Dim hw As Long, hw2 As Long, hw3 As Long, hw4 As Long, hw5 As Long, hw6 As Long, saveRet As Long
    Dim targetPath As String
    
    targetPath = ThisWorkbook.Path & "\" & sPic & ".html"
    
    hw = FindWindow(vbNullString, "Save As")
    hw2 = FindWindowEx(hw, 0&, "DUIViewWndClassName", vbNullString)
    hw3 = FindWindowEx(hw2, 0&, "DirectUIHWND", vbNullString)
    hw4 = FindWindowEx(hw3, 0&, "FloatNotifySink", vbNullString)
    hw5 = FindWindowEx(hw4, 0&, "ComboBox", vbNullString)
    hw6 = FindWindowEx(hw5, 0&, "Edit", vbNullString)
    
    ' 设置完整路径到输入框
    Call SendMessageByString(hw6, WM_SETTEXT, 0, targetPath)
    
    ' 发送回车键触发路径解析与切换
    Call SendMessage(hw6, &H100, &HD, 0) ' WM_KEYDOWN = &H100, VK_RETURN = &HD
    Call SendMessage(hw6, &H101, &HD, 0) ' WM_KEYUP = &H101
    
    ' 等待对话框完成路径切换（可根据实际情况调整等待时长）
    Application.Wait Now + TimeValue("00:00:01")
    
    ' 点击保存按钮
    saveRet = FindWindowEx(hw, 0, "Button", "&Save")
    Call SendMessage(saveRet, BM_CLICK, 0, 0)
End Sub

方案2：直接切换当前工作目录 #

通过API先将程序当前目录切换到目标路径，再设置文件名：

第一步：添加额外API声明 #

在模块顶部补充：

Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long

第二步：修改执行代码 #

Sub Sample(sPic As String)
    Dim hw As Long, hw2 As Long, hw3 As Long, hw4 As Long, hw5 As Long, hw6 As Long, saveRet As Long
    Dim targetDir As String, fileName As String
    
    targetDir = ThisWorkbook.Path
    fileName = sPic & ".html"
    
    ' 切换当前程序工作目录到目标路径
    SetCurrentDirectory targetDir
    
    hw = FindWindow(vbNullString, "Save As")
    hw2 = FindWindowEx(hw, 0&, "DUIViewWndClassName", vbNullString)
    hw3 = FindWindowEx(hw2, 0&, "DirectUIHWND", vbNullString)
    hw4 = FindWindowEx(hw3, 0&, "FloatNotifySink", vbNullString)
    hw5 = FindWindowEx(hw4, 0&, "ComboBox", vbNullString)
    hw6 = FindWindowEx(hw5, 0&, "Edit", vbNullString)
    
    ' 仅设置文件名（目录已切换）
    Call SendMessageByString(hw6, WM_SETTEXT, 0, fileName)
    
    ' 点击保存按钮
    saveRet = FindWindowEx(hw, 0, "Button", "&Save")
    Call SendMessage(saveRet, BM_CLICK, 0, 0)
End Sub

额外注意事项 #

• 不同Windows版本的「另存为」对话框控件层级可能有差异，若路径输入框查找失效，可使用Spy++工具（Visual Studio自带）确认控件的正确层级。
• 确保ThisWorkbook.Path为有效路径，若路径包含空格或特殊字符，可尝试用双引号包裹（如"""" & targetPath & """"）。

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