• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Cancel If File Exists

Logit

Active Member
How would this macro be modified to advise user the file exists (value in M3) ?

Code:
Option Explicit

Sub SavAsPDF()
On Error Resume Next
Dim FileSelected As String
Dim Path As String
Dim x As String
                                            '#####################################
x = Sheets("Sheet1").Range("M3").Value      '<--- Edit this to your sheet and cell
                                            '#####################################

FileSelected = Application.GetSaveAsFilename(InitialFileName:=x, _
                                        FileFilter:="PDF Files (*.pdf), *.pdf", _
                                        Title:="Save PDF as")
                                       
If Not FileSelected <> "False" Then
    MsgBox "You have cancelled"
    Exit Sub
End If
       
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & FileSelected & ".pdf", OpenAfterPublish:=False
MsgBox "File saved to : " & FileSelected
 
   
End Sub
 

Attachments

  • Save As PDF Active Sheet.xlsm
    17.2 KB · Views: 0
I was able to modify to another macro which works as desired. Posted here for others :

Code:
Option Explicit

Sub PDFSaveSht()

Dim wsA As Worksheet: Set wsA = ActiveWorkbook.ActiveSheet
Dim strName, strPath, strFile, strPathFile As String

On Error GoTo errHandler

' Get path
strPath = "C:\Users\My\Desktop\"

' Get and clean filename
strName = Sheets("Sheet1").Range("M3").Value  'Replace(wsA.Range("M3"), " ", "")
'strName = Replace(strName, ".", "_")
strFile = strName & ".pdf"
strPathFile = strPath & strFile

' Check if file exists, prompt overwrite
If bFileExists(strPathFile) Then
    If MsgBox("Overwrite existing file?", _
      vbQuestion + vbYesNo, "File Exists") = vbNo Then

        Do
        strPathFile = Application.GetSaveAsFilename _
          (InitialFileName:=strPathFile, _
              FileFilter:="PDF Files (*.pdf), *.pdf", _
              Title:="Select Folder and FileName to save")

        ' Handle cancel
        If strPathFile = "False" Then Exit Sub

        ' Loop if new filename still exists
        Loop While bFileExists(strPathFile)

    End If
End If

wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=strPathFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

MsgBox "PDF file has been created: " _
            & vbCrLf _
            & strPathFile

Exit Sub

errHandler:
    MsgBox "Could not create PDF file"

End Sub

'=============================
Function bFileExists(rsFullPath As String) As Boolean
  bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
 

Attachments

  • Save PDF w Overwrite Possible.xlsm
    18.1 KB · Views: 1
Hi !

As written in Dir VBA inner help, this function returns a string
if the filename exists so it just needs If Dir(strPathFile) > "" Then
 
Back
Top