如何设置通用文件夹路径以适配VBA的ActiveWorkbook.SaveAs方法？

现有代码核心问题 #

你当前代码的保存逻辑存在三个影响通用性的核心问题：

• 路径写死为C:\Users\name\Desktop\...，其中name是特定用户名，其他用户运行时会因路径不存在直接报错
• 文件名日期格式使用/作为分隔符，属于Windows文件名非法字符，会直接触发保存失败
• 没有判断目标文件夹是否存在，路径缺失时无兜底处理逻辑

具体修改方案 #

方案1：默认保存到当前用户桌面的指定文件夹（满足通用要求） #

这个方案无需用户手动选择路径，所有Windows用户都能正常生成对应文件夹并保存文件，核心修改逻辑：

1. 用Environ("USERPROFILE")动态获取当前用户的系统根目录，拼接得到通用桌面路径
2. 新增文件夹存在校验逻辑，目标文件夹不存在时自动创建
3. 把日期格式的/替换为-，避免文件名非法问题

修改后的完整代码如下：

Sub pasteTable()
    Dim formatting As Variant '创建变量存储formatting2工作簿路径
    Dim saveFolder As String, savePath As String
    
    ' ------------- 新增通用路径配置 -------------
    ' 动态获取当前用户桌面的目标文件夹路径
    saveFolder = Environ("USERPROFILE") & "\Desktop\names Excel Assessment VBA\"
    ' 判断文件夹是否存在，不存在则自动创建
    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolder
    End If
    ' 拼接完整保存路径，替换非法日期分隔符
    savePath = saveFolder & "names Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy")
    ' -------------------------------------------
    
    formatting = Application.GetOpenFilename()  '弹出提示让用户选择formatting2工作簿路径并赋值给formatting变量
    If formatting = False Then Exit Sub ' 新增：用户点取消时直接退出，避免报错
    
    Workbooks.Open formatting  '打开formatting2工作簿
    Worksheets("Formatting").Range("B3:R13").Copy  '复制formatting2工作簿中的表格
    Workbooks.Add  '新建工作簿
    
    Worksheets(1).Range("B3:R13").Select  '选中新工作簿工作表的对应粘贴区域
    Selection.PasteSpecial xlPasteAll '粘贴表格
    
    Columns("B:R").ColumnWidth = 20  '设置表格合适的列宽行高
    Rows("3:13").RowHeight = 25
    
    Worksheets(1).Name = "Table Data"  '重命名工作表
        
    ' 修改SaveAs的路径为动态生成的通用路径
    ActiveWorkbook.SaveAs savePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

方案2：允许用户自主选择保存路径（更灵活） #

如果需要更高的灵活性，可以直接弹出保存对话框让用户自主选择保存位置，完全不需要适配路径：
只需要把原来的SaveAs部分替换为以下代码即可：

Dim userSavePath As Variant
userSavePath = Application.GetSaveAsFilename( _
    InitialFileName:="names Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy"), _
    FileFilter:="Excel 启用宏的工作簿 (*.xlsm), *.xlsm")
If userSavePath <> False Then
    ActiveWorkbook.SaveAs userSavePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If

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