如何修改VBA代码实现跨用户读取与保存桌面文件

你当前代码的问题是路径中硬编码了用户名Mark，只要动态获取当前登录用户的桌面路径替换硬编码部分，即可适配任意用户使用。

两种实现方案 #

方案1：环境变量拼接（简单快捷） #

直接调用VBA内置的Environ函数读取系统用户目录环境变量，拼接得到桌面路径，适合桌面路径为默认位置的场景：

调整后的导入文件代码

Application.CutCopyMode = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & Environ("USERPROFILE") & "\Desktop\next.txt", Destination:=Range("$A$1"))
    .Name = "next"
    .FieldNames = True

调整后的保存文件代码

Sheets("Loader").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete

ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\Load_File" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".CSV", _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True

End With
End Sub

方案2：特殊文件夹读取（兼容性更强） #

如果存在用户手动修改过桌面默认存储位置的情况，使用环境变量拼接可能会失效，推荐用WScript.Shell对象读取系统特殊文件夹路径，兼容性更高：

完整调整后代码

' 代码开头先声明变量获取桌面路径
Dim WshShell As Object
Dim DesktopPath As String
Set WshShell = CreateObject("WScript.Shell")
DesktopPath = WshShell.SpecialFolders("Desktop") & "\"
Set WshShell = Nothing

' 导入文件逻辑
Application.CutCopyMode = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & DesktopPath & "next.txt", Destination:=Range("$A$1"))
    .Name = "next"
    .FieldNames = True


' 保存文件逻辑
Sheets("Loader").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete

ActiveWorkbook.SaveAs Filename:=DesktopPath & "Load_File" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".CSV", _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True

End With
End Sub

注意：如果目标文件不存在会触发运行时错误，建议在路径拼接完成后增加文件存在性校验逻辑，提升代码健壮性。

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