如何修改Excel VBA中的本地文件路径 实现多电脑通用

你只需要做两处小改动就能实现跨设备通用：

• 不用手动拼接带%USERNAME%的路径，直接调用Windows Shell接口获取当前用户桌面路径，兼容性更强，不会因为用户桌面路径自定义、系统装在非C盘等问题报错。
• 新增1行代码获取桌面通用路径，替换原有两处硬编码的文件路径即可，同时可以清理原脚本中冗余的重复打开文件逻辑。

具体实现步骤：

1. 在If MSG1 = vbYes Then代码块的最上方新增代码获取当前用户的桌面路径：

Dim desktopPath As String
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

2. 把原代码中两处硬编码的路径"C:\Users\*User*\Desktop\upload.txt"全部替换为desktopPath & "upload.txt"即可。

修改后的完整代码 #

Sub Order()
'
' Creates Order form Visual Basic control
' Visual Basic script recorded 8/27/2021 by Me
' Copies order to Supplier
'
    Dim MSG1 As VbMsgBoxResult, MSG2 As VbMsgBoxResult
    Dim desktopPath As String
    
    MSG1 = MsgBox("Do you wish to create a new order?", vbYesNo, "New Order Confirmation")

    If MSG1 = vbYes Then
        ' 获取当前用户桌面通用路径
        desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    
        'Copies data
        Range("M1:N300").Select
        Selection.Copy
        Range("A3").Select
    
        'Pastes data to text file
        Workbooks.OpenText Filename:=desktopPath & "upload.txt", Origin:= _
            437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
            , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
            TrailingMinusNumbers:=True
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.Save
        ActiveWindow.Close
        Range("A3").Select
    End If

    'Opens web upload dialog
    MSG2 = MsgBox("Do you wish to upload the order to Supplier?", vbYesNo, "Upload Confirmation")

    If MSG2 = vbYes Then
        Const Hyper As String = "*URL of Supplier*"
        ThisWorkbook.FollowHyperlink Address:=Hyper ', NewWindow:=Tru
    End If

End Sub

如果你坚持要使用拼接%USERNAME%的方式实现，也可以用Environ函数获取用户名：

desktopPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"

该方案仅在用户桌面默认在C盘时可用，兼容性弱于前者。

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