Search code examples
excelvbaexcel-2010

how to export pdf file from excel when the file name already exists then there is a messagebox yes / no with VBA


how to export pdf file from excel when the file name already exists then there is a messagebox yes / no with VBA ?

please recommend so that with the message box I can choose whether yes or not to replace it and another one "cust" this is a subfolder I want there to be a messagebox too if not found the subfolder.

Thanks

Sub PrintToPDF()
Dim strFilename     As String
Dim rngRange        As Range
Dim cust     As Range
Dim strcust As String

Set cust = Worksheets("Sheet1").Range("B2")
Set rngRange = Worksheets("Sheet1").Range("C4")
strcust = cust.Value
strFilename = rngRange.Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "D:\test inv\" & cust & "\" & strFilename & ".pdf" _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True
End Sub

Solution

  • ActiveSheet To PDF (Dir)

    Sub ActiveSheetToPDF()
        
        ' Define constants.
        Const PROC_TITLE As String = "ActiveSheet To PDF"
        Const INITIAL_FOLDER_PATH As String = "D:\test inv\"
        
        ' Reference the active sheet.
        Dim sh As Object: Set sh = ActiveSheet
        If sh Is Nothing Then
            MsgBox "No visible workbooks open.", vbExclamation, PROC_TITLE
            Exit Sub
        End If
            
        ' Build the initial folder path.
        
        Dim pSep As String: pSep = Application.PathSeparator
        Dim iPath As String: iPath = INITIAL_FOLDER_PATH
        If Right(iPath, 1) <> pSep Then iPath = iPath & pSep
        
        Dim TestName As String: TestName = Dir(iPath, vbDirectory)
        
        If Len(TestName) = 0 Then
            MsgBox "The initial path '" & iPath & "' doesn't exist.", _
                vbCritical, PROC_TITLE
            Exit Sub
        End If
           
        ' Retrieve the folder and the file name.
           
        Dim BaseName As String, FolderName As String
           
        With sh.Parent.Worksheets("Sheet1")
            FolderName = CStr(.Range("B2").Value)
            If Len(FolderName) = 0 Then
                MsgBox "The cell with the folder name is blank.", _
                    vbCritical, PROC_TITLE
                Exit Sub
            End If
            BaseName = CStr(.Range("C4").Value)
            If Len(BaseName) = 0 Then
                MsgBox "The cell with the file base name is blank.", _
                    vbCritical, PROC_TITLE
                Exit Sub
            End If
        End With
            
        ' Build the folder path.
            
        Dim FolderPath As String: FolderPath = iPath & FolderName & pSep
        TestName = Dir(FolderPath, vbDirectory)
        
        Dim MsgAnswer As VbMsgBoxResult
        
        If Len(TestName) = 0 Then
            MsgAnswer = MsgBox("The folder '" & FolderName _
                & "' doesn't exist in '" & iPath & "'." & vbLf & vbLf _
                & "Do you want it created?", vbQuestion + vbYesNo, PROC_TITLE)
            If MsgAnswer = vbNo Then Exit Sub
            Dim ErrNum As Long
            On Error Resume Next
                MkDir FolderPath
                ErrNum = Err.Number
            On Error GoTo 0
            If ErrNum <> 0 Then
                MsgBox "The path '" & FolderPath & "' couldn't be created.", _
                    vbCritical, PROC_TITLE
                Exit Sub
            End If
        End If
            
        ' Build the file path.
            
        Dim FilePath As String: FilePath = FolderPath & BaseName & ".pdf"
        TestName = Dir(FilePath)
        
        If Len(TestName) > 0 Then
            MsgAnswer = MsgBox("A file named '" & TestName _
                & "' already exists in '" & FolderPath & "'." & vbLf & vbLf _
                & "Do you want to overwrite it?", vbQuestion + vbYesNo, PROC_TITLE)
            If MsgAnswer = vbNo Then Exit Sub
        End If
        
        ' Export.
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True
        
        ' Inform.
        MsgBox "Sheet '" & sh.Name & "' printed to PDF.", _
            vbInformation, PROC_TITLE
        
    End Sub