Save excel as PDF in Specific (Dynamic) Location

Question

I am trying to create macro that save specific sheets from workbook and export as pdf to specific location. Currently I am using default location and it save the file in documents folder in my PC but when I send email it save the file in last used folder of the user. I want to save the file to Documents folder of user.

Sub ExportAsPDF()
     
    Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
   
MsgBox "All PDF's have been successfully exported."

End Sub

xris23 · Answer 1 · 2022-02-23T15:50:49.793

Dim Path as string
Dim output_filename as string

  

      Path = ThisWorkbook.Sheets("sheet1").Range("A1")
    output_filename = ThisWorkbook.Sheets("sheet1").Range("A2")
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & output_filename & ".pdf"

You can also replace Path and output_filename with a fixed text.

You can make it flexible with using one of the objUser. attributes

Sub test2()
'userinfo.vbs

' Usage:
'       cscript //Nologo userinfo.vbs

' List User properties as displayed in ADUC

On Error Resume Next
Dim objSysInfo, objUser
Set objSysInfo = CreateObject("ADSystemInfo")

' Currently logged in User
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
 ' or specific user:
 'Set objUser = GetObject("LDAP://CN=johndoe,OU=Users,DC=ss64,DC=com")

ActiveWorkbook.Sheets("Sheet1").Range("A2").Value = "DN: " & objUser.distinguishedName
ActiveWorkbook.Sheets("Sheet1").Range("A3").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A4").Value = "GENERAL"
ActiveWorkbook.Sheets("Sheet1").Range("A5").Value = "First name: " & objUser.givenName
'ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "First name: " & objUser.FirstName
ActiveWorkbook.Sheets("Sheet1").Range("A6").Value = "Initials: " & objUser.initials
ActiveWorkbook.Sheets("Sheet1").Range("A7").Value = "Last name: " & objUser.sn
'ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Last name: " & objUser.LastName
ActiveWorkbook.Sheets("Sheet1").Range("A8").Value = "Display name: " & objUser.DisplayName
'ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Display name: " & objUser.FullName
ActiveWorkbook.Sheets("Sheet1").Range("A9").Value = "Description: " & objUser.Description
ActiveWorkbook.Sheets("Sheet1").Range("A10").Value = "Office: " & objUser.physicalDeliveryOfficeName
ActiveWorkbook.Sheets("Sheet1").Range("A11").Value = "Telephone number: " & objUser.telephoneNumber
ActiveWorkbook.Sheets("Sheet1").Range("A12").Value = "Other Telephone numbers: " & objUser.otherTelephone
ActiveWorkbook.Sheets("Sheet1").Range("A13").Value = "Email: " & objUser.mail
' ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Email: " & objUser.EmailAddress
ActiveWorkbook.Sheets("Sheet1").Range("A14").Value = "Web page: " & objUser.wWWHomePage
ActiveWorkbook.Sheets("Sheet1").Range("A15").Value = "Other Web pages: " & objUser.URL
ActiveWorkbook.Sheets("Sheet1").Range("A16").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A17").Value = "ADDRESS"
ActiveWorkbook.Sheets("Sheet1").Range("A18").Value = "Street: " & objUser.streetAddress
ActiveWorkbook.Sheets("Sheet1").Range("A19").Value = "P.O. Box: " & objUser.postOfficeBox
ActiveWorkbook.Sheets("Sheet1").Range("A20").Value = "City: " & objUser.l
ActiveWorkbook.Sheets("Sheet1").Range("A21").Value = "State/province: " & objUser.st
ActiveWorkbook.Sheets("Sheet1").Range("A22").Value = "Zip/Postal Code: " & objUser.postalCode
ActiveWorkbook.Sheets("Sheet1").Range("A23").Value = "Country/region: " & objUser.countryCode
'ActiveWorkbook.Sheets("Sheet1").Range("A4").Value =  "Country/region: " & objUser.c    '(ISO 4217)
ActiveWorkbook.Sheets("Sheet1").Range("A24").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A25").Value = "ACCOUNT"
ActiveWorkbook.Sheets("Sheet1").Range("A26").Value = "User logon name: " & objUser.userPrincipalName
ActiveWorkbook.Sheets("Sheet1").Range("A27").Value = "pre-Windows 2000 logon name: " & objUser.sAMAccountName
ActiveWorkbook.Sheets("Sheet1").Range("A28").Value = "AccountDisabled: " & objUser.AccountDisabled
' ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Account Control #: " & objUser.userAccountControl
ActiveWorkbook.Sheets("Sheet1").Range("A29").Value = "Logon Hours: " & objUser.logonHours
ActiveWorkbook.Sheets("Sheet1").Range("A30").Value = "Logon On To (Logon Workstations): " & objUser.userWorkstations
' ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "User must change password at next logon: " & objUser.pwdLastSet
ActiveWorkbook.Sheets("Sheet1").Range("A31").Value = "User cannot change password: " & objUser.userAccountControl
ActiveWorkbook.Sheets("Sheet1").Range("A32").Value = "Password never expires: " & objUser.userAccountControl
ActiveWorkbook.Sheets("Sheet1").Range("A33").Value = "Store password using reversible encryption: " & objUser.userAccountControl
' ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Account expires end of (date): " & objUser.accountExpires
ActiveWorkbook.Sheets("Sheet1").Range("A34").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A35").Value = "PROFILE"
ActiveWorkbook.Sheets("Sheet1").Range("A36").Value = "Profile path: " & objUser.profilePath
' ActiveWorkbook.Sheets("Sheet1").Range("A5").Value =  "Profile path: " & objUser.Profile
ActiveWorkbook.Sheets("Sheet1").Range("A37").Value = "Logon script: " & objUser.scriptPath
ActiveWorkbook.Sheets("Sheet1").Range("A38").Value = "Home folder, local path: " & objUser.homeDirectory
ActiveWorkbook.Sheets("Sheet1").Range("A39").Value = "Home folder, Connect, Drive: " & objUser.homeDrive
ActiveWorkbook.Sheets("Sheet1").Range("A40").Value = "Home folder, Connect, To:: " & objUser.homeDirectory
ActiveWorkbook.Sheets("Sheet1").Range("A41").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A42").Value = "TELEPHONE"
ActiveWorkbook.Sheets("Sheet1").Range("A43").Value = "Home: " & objUser.homePhone
ActiveWorkbook.Sheets("Sheet1").Range("A44").Value = "Other Home phone numbers: " & objUser.otherHomePhone
ActiveWorkbook.Sheets("Sheet1").Range("A45").Value = "Pager: " & objUser.pager
ActiveWorkbook.Sheets("Sheet1").Range("A46").Value = "Other Pager numbers: " & objUser.otherPager
ActiveWorkbook.Sheets("Sheet1").Range("A47").Value = "Mobile: " & objUser.mobile
ActiveWorkbook.Sheets("Sheet1").Range("A48").Value = "Other Mobile numbers: " & objUser.otherMobile
ActiveWorkbook.Sheets("Sheet1").Range("A49").Value = "Fax: " & objUser.facsimileTelephoneNumber
ActiveWorkbook.Sheets("Sheet1").Range("A50").Value = "Other Fax numbers: " & objUser.otherFacsimileTelephoneNumber
ActiveWorkbook.Sheets("Sheet1").Range("A51").Value = "IP phone: " & objUser.ipPhone
ActiveWorkbook.Sheets("Sheet1").Range("A52").Value = "Other IP phone numbers: " & objUser.otherIpPhone
ActiveWorkbook.Sheets("Sheet1").Range("A53").Value = "Notes: " & objUser.info
ActiveWorkbook.Sheets("Sheet1").Range("A54").Value = ""
ActiveWorkbook.Sheets("Sheet1").Range("A55").Value = "ORGANISATION"
ActiveWorkbook.Sheets("Sheet1").Range("A56").Value = "Title: " & objUser.Title
ActiveWorkbook.Sheets("Sheet1").Range("A57").Value = "Department: " & objUser.department
ActiveWorkbook.Sheets("Sheet1").Range("A58").Value = "Company: " & objUser.company
ActiveWorkbook.Sheets("Sheet1").Range("A59").Value = "Manager: " & objUser.manager
End Sub

There are two challenges with the suggested code. 1. The file will be shared via email and address cannot be fixed. Like It will be (User)/Documents. 2. I have tried the same code but getting error Document not saved. The Document may be open, or an error may have been encountered when saving. — Faisal Shahzad, Feb 23 '22 at 15:19
Maybe you can use AD code? See https://stackoverflow.com/questions/21110232/getting-ad-details-based-on-username then you can retrieve username and e-mail from the user which is opening the file. Then use this username in the string for the path. — xris23, Feb 23 '22 at 15:30

Save excel as PDF in Specific (Dynamic) Location

1 Answers1