Как сделать путь к папке универсальным?

Измените строку сохранения на эту:

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

То Username системная переменная будет изменяться в зависимости от используемой учетной записи Windows. Просто убедитесь, что у каждого пользователя на рабочем столе тоже есть эти папки, иначе вы получите сообщение об ошибке. Я также удалил names судя по именам папок, как я предполагаю, вы также пытались что-то сделать с именем пользователя там. Вы можете приспособить это к своим потребностям.

Ваш формат даты тоже нужно было изменить, так как он включал запрещенные символы.

Вы также забыли указать расширение файла, поэтому я добавил и это.

С этой линией многое происходит, в том числе много ошибок, поэтому вам придется немного поиграть с ней, пока вы не получите именно то, что вам нужно. Возможно, вам захочется немного упростить его, пока вы не освоитесь со всеми этими вещами.

Я думаю, вам нужно добавить еще несколько проверок

Сценарий ожидает, что имя папки-пути к инструменту будет постоянным ToolFolder.

Плюс вторая константа ToolBaseFolder это может быть установлено в папку инструментов родительского пути, например, сетевой путь. Если константа пуста, будет использоваться рабочий стол пользователя.

Если этот путь еще не существует, он будет создан.

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