我需要在Excel中设置VBA的路径，以便文件可以在多台计算机上使用

Question

我有一个excel文件，为我们的供应商创建一个订单，我使用VBA脚本将数据复制到另一个文件，并以供应商使用的方式格式化它。现在它正常运行了，我的老板希望在我们的其他地方使用这种方法。问题是这个脚本是为我们的本地计算机量身定制的。

我需要将路径从本地驱动器更改为文件保存在脚本中的位置:

C:Users*User*Desktop

变成一般的

C:Users%USERNAME%Desktop

我已经看了几个选项，但真的很困惑的最简单的方式正确地做到这一点。

下面是我当前使用的代码:

Sub Order()
'
' Creates Order form Visual Basic control
' Visual Basic script recorded 8/27/2021 by Me
' Copies order to Supplier
'

MSG1 = MsgBox("Do you wish to create a new order?", vbYesNo, "New Order Confirmation")
If MSG1 = vbYes Then

'Copies data
Range("M1:N300").Select
Selection.Copy
Range("A3").Select

'Pastes data to text file
Workbooks.OpenText Filename:="C:Users*User*Desktopupload.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

'Closes text file
Dim wb As Workbook
Set wb = Application.Workbooks.Open("C:Users*User*Desktopupload.txt")
wb.Close
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

Answer 1

我通常使用Ron de Bruins网站上的代码。

Sub Test()
Dim WshShell As Object
Dim DeskTopPath As String
Set WshShell = CreateObject("WScript.Shell")
DeskTopPath = WshShell.SpecialFolders("Desktop")
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(DeskTopPath & "upload.txt")

wrkBk.Save
wrkBk.Close
End Sub

特殊文件夹有:AllUsersDesktop, AllUsersStartMenuAllUsersPrograms, AllUsersStartup, Desktop, Favorites字体，我的文件，NetHood, PrintHood，程序，最近SendTo, StartMenu, Startup, Templates