Saving to Desktop....

[RandyD123]

I am using this code to create and save my excel file to a PDF file in the current directory. However I would like it to save to my desktop by default if possible. This file exists on sharepoint and all users should be able to click the "Export As PDF" button and the default save should be the desktop..... The path to the desktop is "C:\Users\%username%\OneDrive - USTSA\Desktop". Thank you in advance.....

Sub Save_PDF_with_Prompt()

Dim xWs As Worksheet
Dim xWb As Workbook
Dim xTime As String
Dim xName As String
Dim xPath As String
Dim xFile As String
Dim yPathFile As String
Dim zFile As Variant

On Error GoTo errHandler

Set xWb = ActiveWorkbook
Set xWs = ActiveSheet
xTime = Format(Date - 1, "mm.dd.yyyy")

xPath = xWb.Path
If xPath = "" Then
  xPath = Application.DefaultFilePath
End If
xPath = xPath & "\"

xName = Replace(xWs.Name, " ", "")
xName = Replace(xName, ".", "_")

xFile = xWs.Name & "_" & xTime & ".pdf"
yPathFile = xPath & xFile

zFile = Application.GetSaveAsFilename _
    (InitialFileName:=yPathFile, _
        FileFilter:="PDF Format (*.pdf), *.pdf", _
        Title:="Save As a PDF File")

If zFile <> "False" Then
    xWs.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=zFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    MsgBox "Successfully Saved As a PDF: " _
      & vbCrLf _
      & zFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Failed to Save"
    Resume exitHandler

End Sub

 

[RandyD123]

Personally I would use the method in post 8 (not sure why the credit to SO, as it is an old method).
You would use it a replacement for your XPath

XPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

xName = Replace(xWs.Name, " ", "")
xName = Replace(xName, ".", "_")

xFile = xWs.Name & "_" & xTime & ".pdf"
yPathFile = XPath & xFile

Ok I will try it. Thank you.