Come rendere il percorso della cartella di universale?

Cambiare la vostra linea Salva in questo modo:

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

Il Username la variabile di sistema per regolare a seconda dell'account di Windows in uso. Basta assicurarsi che ogni utente ha le cartelle esistenti sul desktop troppo, o si otterrà un errore. Ho anche rimosso names dalla cartella nomi come presumo si stavano cercando di fare qualcosa con il nome utente lì. È possibile regolare che per le tue esigenze.

Il formato di Data necessari per cambiare troppo, come è stato tra i caratteri illegali.

Hai anche dimenticato di includere l'estensione di un file, così ho aggiunto che, come bene.

C'è un sacco di cose con quella linea, tra cui un sacco di errori, e così si sta andando ad avere per giocare con un po ' fino ad ottenere esattamente ciò di cui avete bisogno. È possibile semplificare un po ' fino a quando si ottiene il blocco di tutte quelle cose.

Credo che si debba aggiungere un pò più di controlli

Lo script prevede che il nome del percorso utensile-cartella costante ToolFolder.

Più una seconda costante ToolBaseFolder che può essere impostato per il genitore-percorso `ToolFolder, ad esempio, un percorso di rete. Se il const è vuota, gli utenti desktop verrà utilizzata.

Se questo percorso non esiste verrà creato.

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