Jak zrobić ścieżkę do folderu uniwersalnym?

Zmień wiersz zapisać na ten:

ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

To Username zmienna systemowa będzie się różnić w zależności od używanego konta Windows. Po prostu upewnij się, że u każdego użytkownika na pulpicie też mam te foldery, w przeciwnym razie pojawi się komunikat o błędzie. Usunąłem też names sądząc po nazwach folderów, jak sądzę, również próbowali coś zrobić z nazwą użytkownika tam. Możesz dostosować to do swoich potrzeb.

Twój format daty też trzeba było zmienić, tak jak on zawierał niedozwolone znaki.

Możesz również zapomnieć podać rozszerzenie pliku, więc dodałem i to.

Z tą linią wiele się dzieje, w tym wiele błędów, więc trzeba trochę pobawić się z nią, dopóki nie otrzymasz dokładnie to, co trzeba. Możliwe, że chcesz trochę uprościć go, dopóki nie są wygodne z tymi wszystkimi rzeczami.

Myślę, że trzeba dodać jeszcze kilka kontroli

Scenariusz spodziewa się, że nazwa folderu-drodze do instrumentu będzie stałym ToolFolder.

Plus druga stała ToolBaseFolder to może być instalowana w folderze narzędzi rodzicielskiej drodze, na przykład, ścieżki sieciowej. Jeśli stała pusta, będzie używany pulpit użytkownika.

Jeżeli w ten sposób nie istnieje, zostanie on utworzony.

Option Explicit

Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"


Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub


Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub



Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder

Dim basepath As String
basepath = ToolBaseFolder & "\"

If existsFolder(basepath) = False Then
    If LenB(ToolBaseFolder) > 0 Then
        MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
            "File will be saved to " & ToolFolder & " on desktop ", vbExclamation
    End If
    basepath = getDesktopFolderOfUser
End If

Dim fullpath As String
fullpath = basepath & ToolFolder & "\"

If existsFolder(fullpath) = False Then
    makeFolder fullpath
End If

getToolFolder = fullpath

End Function


Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function

Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function

Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function