VBA - if the file already exists, i want to receive a message. RRS feed

  • Question

  • Dear Friends! I have this Macro and now I need some help to finalize it.
    How can I, when I press a button to save a file, and if the file already exists, i want to receive a message that the file exists.

    Private Sub cmdSavePDF_Click()

    Dim path    As String
    Dim fname   As String
    Dim invName As String

       With Sheet3 
          invName = .Range("A13").Value & "-" & .Range("I7").Value
       End With
       invName = Replace(invName, "/", "_")
       path = "C:\Anita\"
       Call MkDir(path)
       path = path & "Invoices 2018\" '
       Call MkDir(path)
       path = path & Sheet3.Range("A13").Value
       Call MkDir(path)
       fname = path & "\" & invName

       Sheet3.Range("A1:j46").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fname, _
          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
          IgnorePrintAreas:=True, OpenAfterPublish:=True

    End Sub

    Thursday, June 21, 2018 3:21 PM

All replies

  • Does fname include the extension .pdf? If not, I'd use

       fname = path & "\" & invName & ".pdf"

    Below this line, insert the following:

        If Dir(fname) <> "" Then
            If MsgBox("The file " & fname & " already exists." & vbCrLf & _
                "Do you want to continue and overwrite it?", _
                vbQuestion + vbYesNo) = vbNo Then Exit Sub
        End If

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, June 21, 2018 3:52 PM
  • An alternative approach is to ensure that the name never exists by numbering duplicate versions of the file. You can use the following macro function to do that (it works in Word also)

    Public Function FileNameUnique(strPath As String, _
                                   strfilename As String, _
                                   strExtension As String) As String
    'Graham Mayor - http://www.gmayor.com - Last updated - 22 Jun 2018
    'strPath is the path in which the file is to be saved
    'strFilename is the filename to check
    'strextension is the extension of the filename to check
    Dim lng_F As Long
    Dim lng_Name As Long
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        strExtension = Replace(strExtension, Chr(46), "")
        lng_F = 1
        lng_Name = Len(strfilename) - (Len(strExtension) + 1)
        strfilename = Left(strfilename, lng_Name)
        'If the filename exists, add or increment a number to the filename
        'and keep checking until a unique name is found
        Do While fso.FileExists(strPath & strfilename & Chr(46) & strExtension) = True
            strfilename = Left(strfilename, lng_Name) & "(" & lng_F & ")"
            lng_F = lng_F + 1
        'Reassemble the filename'
        FileNameUnique = strfilename & Chr(46) & strExtension
        Set fso = Nothing
        Exit Function
    End Function
    Sub TestSave()
    Dim strName As String, strPath As String
        strPath = "C:\Path\" 'The path to save to
        strName = "Test.xlsx" 'The name of the file
        strName = FileNameUnique(strPath, strName, "xlsx")
        ActiveWorkbook.SaveAs strPath & strName
    End Sub

    Graham Mayor - Word MVP

    Friday, June 22, 2018 3:50 AM