Email PDF

[Jenna_B]

I am having a slight issue with my code, and perhaps I have been looking at it to long BUT, I am looking to have the ability to choose a new file name instead of just overwrite the existing file.
My current Filename string is : DestFolder & "_" & Format(Now(), "yyyymmdd") & "_" & (Environ$("Username")) & ".pdf" and I think I would like the file to save as -1, or -2, or -3 depending on how many filenames have already been found. My full code here:

Sub create_and_email_pdf()



Dim EmailSubject As String, EmailSignature As String

Dim CurrentMonth As String, DestFolder As String, PDFFile As String

Dim Email_To As String, Email_CC As String, Email_BCC As String

Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean

Dim OverwritePDF As VbMsgBoxResult

Dim OutlookApp As Object, OutlookMail As Object

CurrentMonth = ""

PDFFile = "Valve Conversion Request" & "_" & Format(Now(), "yyyymmdd") & "_" & (Environ$("Username")) & ".pdf"

DestFolder = "I:\Valve Conversion Requests"





    EmailSubject = "Valve Conversion Request"

    OpenPDFAfterCreating = False   

    AlwaysOverwritePDF = False 

    DisplayEmail = True

    Email_To = ActiveSheet.Range("N1")

    Email_CC = ""

    Email_BCC = ""

    



    CurrentMonth = Mid(ActiveSheet.Range("N2").Value, InStr(1, ActiveSheet.Range("N2").Value, " ") + 1)

  



    PDFFile = DestFolder & "_" & Format(Now(), "yyyymmdd") & "_" & (Environ$("Username")) & ".pdf"





    If Len(Dir(PDFFile)) > 0 Then

    

        If AlwaysOverwritePDF = False Then

        

            OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")

        

            On Error Resume Next



            If OverwritePDF = vbYes Then

    

                Kill PDFFile

        

            Else

    

                MsgBox "Unable to continue." _

                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"

                

                Exit Sub

        

            End If



        Else

        

            On Error Resume Next

            Kill PDFFile

          

        End If

      

        If Err.Number <> 0 Then

      

            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _

                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"

              

            Exit Sub

      

        End If

          

    End If

 

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

        :=False, OpenAfterPublish:=OpenPDFAfterCreating



    Set OutlookApp = CreateObject("Outlook.Application")

    Set OutlookMail = OutlookApp.CreateItem(0)

      

    With OutlookMail

      

        .Display

        .To = Email_To

        .CC = Email_CC

        .BCC = Email_BCC

        .Subject = EmailSubject

        .Attachments.Add PDFFile

              

        If DisplayEmail = False Then

          

            .Send

          

        End If

      

    End With

  



End Sub

 

[Jenna_B]

I fixed this... I figured what I filled out actually contains a field I could reference that has a unique identifier in it.
However, my issue is now that the PDF file isn't saving to the destination folder....