वीबीए: उपयोगकर्ता की परवाह किए बिना एक्सेल वर्कबुक को डेस्कटॉप पर कैसे सहेजना है?

Question

मेरे पास एक एक्सेल वर्कबुक है जो फॉर्म बटन पर क्लिक करें, मुझे कार्यपुस्तिका की एक प्रति उपयोगकर्ता के डेस्कटॉप पर सहेजने की आवश्यकता है।

मूल रूप से सबकुछ साझा नेटवर्क फ़ोल्डर पर होने वाला था, लेकिन अब मेरे पास लगभग 6 अलग-अलग उपयोगकर्ता हैं जो बटन पर क्लिक करते समय, मुझे कार्यपुस्तिका को अपने व्यक्तिगत डेस्कटॉप पर सहेजने की आवश्यकता होती है।

क्या व्यक्तिगत उपयोगकर्ताओं को निर्दिष्ट किए बिना मशीन डेस्कटॉप पर सहेजने के लिए उनका एक तरीका (कोडिंग-वार) है (जो मुझे 6 अलग-अलग वर्कबुक फाइलों को बनाए रखने की आवश्यकता होगी)?

Answer 1

मुझे लगता है कि यह डेस्कटॉप पथ प्राप्त करने का सबसे विश्वसनीय तरीका है जो हमेशा उपयोगकर्ता नाम के समान नहीं होता है।

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

Answer 2

आप उल्लेख किया है वे एक अपनी स्वयं की मशीन है, लेकिन है कि वे एक सह कार्यकर्ता मशीन पर लॉग इन करने के लिए, और उसके बाद की जरूरत है फ़ाइल का उपयोग, "सी के माध्यम से यह बचत: \ Users \ लोक \ डेस्कटॉप \ "यह विभिन्न उपयोगकर्ता नामों के लिए उपलब्ध कराएगा।

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

मुझे यकीन नहीं है कि यह एक आवश्यकता होगी, लेकिन मदद कर सकता है!

Answer 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 

यह अगले बिट मैं पीडीएफ के रूप में फाइल को सेव उपयोग करें, लेकिन बदल सकते हैं सूट करने के लिए

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