VBA设置另存为路径与原文档所在文件夹一致的问题求助

我来帮你搞定这个问题！你的核心需求是让另存为对话框默认打开当前文档所在的文件夹，而不是系统默认的Documents目录，同时你的现有代码存在几个小问题（比如变量拼写错误、冗余逻辑），下面是调整后的完整解决方案：

Sub CustomSaveAs()
    Dim InitialName As String
    Dim fileSaveName As Variant
    
    ' 生成带原文档路径的初始文件名，让对话框默认定位到该文件夹
    InitialName = ThisWorkbook.Path & "\" & Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" & Range("q1")
    
    ' 调用另存为对话框，此时会自动默认打开原文档所在文件夹
    fileSaveName = Application.GetSaveAsFilename( _
        InitialFileName:=InitialName, _
        FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
    
    ' 如果用户取消对话框，直接退出子程序
    If fileSaveName = False Then Exit Sub
    
    ' 处理保存操作，加入错误捕获
    On Error Resume Next
    ActiveWorkbook.SaveAs Filename:=fileSaveName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    If Err.Number = 1004 Then
        MsgBox "保存失败啦！可能是文件名无效或者没有写入权限哦", vbExclamation
    End If
    On Error GoTo 0
End Sub

关键调整说明： #

• 默认路径设置：把初始文件名拼接上ThisWorkbook.Path & "\"，这是核心！GetSaveAsFilename会自动识别这个路径，打开对话框时直接定位到原文档所在的文件夹。
• 修正变量拼写：你原来写的IntialName少了个字母，改成InitialName，避免运行时报错。
• 简化保存逻辑：原代码里重复拼接路径会导致错误（因为fileSaveName已经包含用户选择的完整路径+文件名了），直接用这个变量就行，不用再额外加路径。
• 优化错误提示：统一处理保存时的常见错误（比如文件名非法、权限不足），给个友好的提示，方便排查问题。

额外小提示： #

如果你的文档是新建还没保存过的，ThisWorkbook.Path会是空字符串，这时候对话框会回到系统默认路径。要是想处理这种情况，可以加个判断：

Dim basePath As String
If ThisWorkbook.Path <> "" Then
    basePath = ThisWorkbook.Path & "\"
Else
    ' 未保存过的文档，默认指向桌面
    basePath = Environ("USERPROFILE") & "\Desktop\"
End If
InitialName = basePath & Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" & Range("q1")

内容的提问来源于stack exchange，提问作者Sid. T.