VBA: Как сохранить книгу Excel на рабочий стол независимо от пользователя?

У меня есть учебник Excel, который при нажатии кнопки "Форма" мне нужно сохранить копию рабочей книги на рабочем столе пользователя.

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

Их способ (кодирование) сохранить на компьютере Desktop без указания отдельных пользователей (что потребует от меня поддерживать 6 разных файлов рабочей книги)?

Ответ 1

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

MsgBox CreateObject("WScript.Shell").specialfolders("Desktop")

Ответ 2

Вы упомянули, что каждый из них имеет свои собственные машины, но если им нужно войти в систему для совместной работы, а затем использовать файл, сохранение его через "C:\Users\Public\Desktop \" сделает он доступен для разных имен пользователей.

Public Sub SaveToDesktop()
    ThisWorkbook.SaveAs Filename:="C:\Users\Public\Desktop\" & ThisWorkbook.Name & "_copy", _ 
    FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Я не уверен, было ли это требованием, но может помочь!

Ответ 3

Не уверен, что это все еще актуально, но я использую этот способ

Public bEnableEvents As Boolean
Public bclickok As Boolean
Public booRestoreErrorChecking As Boolean   'put this at the top of the module

 Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function GetUserID() As String
' Returns the network login name
On Error Resume Next
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
    GetUserID = Left$(strUserName, lngLen - 1)
Else
    GetUserID = ""
End If
Exit Function
End Function

Этот следующий бит я сохраняю файл в формате PDF, но могу изменить его в соответствии с

Public Sub SaveToDesktop()
Dim LoginName As String
LoginName = UCase(GetUserID)

ChDir "C:\Users\" & LoginName & "\Desktop\"
Debug.Print LoginName
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\Users\" & LoginName & "\Desktop\MyFileName.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
End Sub