Cómo hacer la ruta de la carpeta universal?

Cambiar de Guardar la línea a este:

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

El Username la variable del sistema se ajustará dependiendo de la cuenta de Windows que está en uso. Sólo asegúrese de que cada usuario tiene esas carpetas existentes en su escritorio demasiado, o se producirá un error. También he quitado names de los nombres de carpeta como supongo que estaba tratando de hacer algo con el nombre de usuario de la misma. Usted puede ajustar a sus necesidades.

Su formato de Fecha que se necesitan para cambiar demasiado como estaba incluyendo caracteres ilegales.

También se olvidó de incluir un archivo de extensión, por lo que añadió que como bien.

No hay mucho que hacer en esa línea, incluyendo un montón de errores, entonces usted va a tener que jugar un poco con ella hasta que se obtiene exactamente lo que usted necesita. Puede que desee simplificar un poco hasta que usted consiga la caída de todas esas cosas.

Creo que tienes que añadir algo más de cheques

El script espera el nombre de la herramienta de la ruta de la carpeta como constante ToolFolder.

Además de una segunda constante ToolBaseFolder que se podría establecer a los padres de la ruta `ToolFolder, por ejemplo, una ruta de red. Si la constante es vacío, los usuarios de escritorio va a ser utilizado.

Si este camino aún no existe será creado.

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