Setting initial file name and path on GetSaveAsFilename

[devofish]

I can't seem to figure out why upon GetSaveAsFilename, the file path is not what is coded. If I use the FolderName, the InitialFileName works, but if I tie FileName to the address, it defaults to Documents. The routine also needs to check if the document is open (if open, close it) and/or if the document exists (if true, prompt to overwrite). Any assistance is appreciated.

Public Sub CreatePDF()

    Dim iFile As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    username = Environ("username") 'user
    FolderName = "C:\Users\" & username & "\Documents\Project\blahblah"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    On Error GoTo ErrHandler

        strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") & "_" _
        & Replace(ActiveWorkbook.FullName, ".xlsm", "_") _
        & "Report_" & Format(Now(), "yyyymmdd\_ampm") & ".pdf"
   
        iFile = FolderName & "\" & strFile

        myFile = Application.GetSaveAsFilename(InitialFileName:=iFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Save Report to Directory")
  
        If myFile <> "False" Then
            ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
            ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:=strFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
            MsgBox "PDF file has been created.", vbInformation, ""
        End If

ExitHandler:
    Exit Sub
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
ErrHandler:
    MsgBox "The PDF file could not be created!", vbExclamation, ""
    Resume ExitHandler
End Sub

 

[Fluff]

Make this change

Replace(ActiveWorkbook.Name, ".xlsm", "_")

 

[Fluff]

Forgot to mention, that you have a problem with your error handler.

ExitHandler:
    Exit Sub
    Application.EnableEvents = True
    Application.ScreenUpdating = True

This will exit the macro before turning Events & screenupdating back on. Try it like this instead.

       MsgBox "PDF file has been created.", vbInformation, ""
   End If
   Application.EnableEvents = True
   Application.ScreenUpdating = True

Exit Sub
ErrHandler:
   MsgBox "The PDF file could not be created!", vbExclamation, ""
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

 

[devofish]

Thanks, Fluff.
How easy is it to add code to check if the file already exists?
Right now if the file exists, it just overwrites it with no prompt. With the code below, it throws a run-time error.

Dim TestStr As String    
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(iFile)
    On Error GoTo 0
        If TestStr = "" Then
            If myFile <> "False" Then
                 ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
                 ActiveSheet.ExportAsFixedFormat _
                 Type:=xlTypePDF, _
                 filename:=strFile, _
                 Quality:=xlQualityStandard, _
                 IncludeDocProperties:=True, _
                 IgnorePrintAreas:=False, _
                 OpenAfterPublish:=True
                 MsgBox "PDF file has been created.", vbInformation, ""
            End If
        Else
            MsgBox "The " & strFile & " already exists. Would you like to overwrite the file?", vbQuestion
        End If

 

[Fluff]

Try

    On Error GoTo ErrHandler

     strFile = Replace(Replace(Ws.Name, " ", ""), ".", "_") & "_" _
     & Replace(ActiveWorkbook.Name, ".xlsm", "_") _
     & "Report_" & Format(Now(), "yyyymmdd\_ampm") & ".pdf"

     iFile = FolderName & "\" & strFile

     myfile = Application.GetSaveAsFilename(InitialFileName:=iFile, _
             FileFilter:="PDF Files (*.pdf), *.pdf", _
             title:="Save Report to Directory")
             
      If Dir(myfile) <> "" Then
         If MsgBox("The " & strFile & " already exists. Would you like to overwrite the file?", vbYesNo) = vbNo Then GoTo ErrHandler
      End If
      If myfile <> "False" Then
          ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
          ActiveSheet.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          fileName:=myfile, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True
          MsgBox "PDF file has been created.", vbInformation, ""
      End If
   Application.EnableEvents = True
   Application.ScreenUpdating = True

Exit Sub
ErrHandler:
   MsgBox "The PDF file could not be created!", vbExclamation, ""
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

 

[devofish]

Thanks, Fluff.

Final Code:

Public Sub CreatePDF()

Set wb = ThisWorkbook
Set ws = wb.Sheets(Sheet1)
username = Environ("username") 'user
FolderName = "C:\Users" & username & "\Desktop"

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error GoTo ErrHandler

strFile = Application.WorksheetFunction.Proper(ws.Range("C6")) _
& "_Report_" & Format(Now(), "yyyymmdd\_ampm") & ".pdf"

iFile = FolderName & "" & strFile
cFile = IsFileOpen(iFile)

myFile = Application.GetSaveAsFilename(InitialFileName:=iFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Save Report to Directory")

If cFile = True Then
MsgBox "The " & strFile & " PDF file is currently open. Close the file to save the PDF.", vbInformation, "Report"
Exit Sub
Else
End If

If Dir(myFile) <> "" Then
If MsgBox("The " & strFile & " already exists. Overwrite the file?", vbQuestion + vbYesNo) = vbNo Then GoTo ErrHandler
End If
If myFile <> "False" Then
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=strFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
MsgBox "PDF file has been created. Please review the report for " & _
"formatting or reporting errors.", vbInformation, "Report"
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox "A PDF file was not created!", vbExclamation, "Report"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Function IsFileOpen(FileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=ff]#ff[/URL] 
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error ErrNo
End Select
End Function

 

[Fluff]

Glad to help & thanks for the feedback