CODEWITHSUNDEEP
excelvbaemail-attachments
mark
mark

Reputation: 1

I am looking for a VBA Code to attach PDF File to email but PDF File name changes with every email

I am building a P.O. system to track purchases.

Users fill in information on the tab Open P.O. Form using the drop down options i have create.

Once all boxes are complete the user will eventually hit a create button that will assign a unique PO #

All the data will be saved on the Data Base Tab and a PDF File will be created and saved on my network drive.

The name of the PDF file will be "Cont Vrac P.O. 420-10000x" where x=x+1. every PO that is created will increase the P.O.# by one. Exe the first PO Create will be 420-100001 the second PO will be 420-100002 etc...

I cannot get the file to attach, to the email. I suppose because it does not know what file to pick up.

All the other code works. The attach PDF is the last piece to this puzzle.

Sub Create_Save_And_Send_PDF()

Dim xOutlookObj As Object
Set xOutlookObj = CreateObject("Outlook.Application")

Dim xEmailObj As Object
Set xEmailObj = xOutlookObj.CreateItem(0)

'This makes "Open PO Form" as the active worksheet
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Open P.O. Form")

'This designates the range on Open PO Form that will be included in the PO PDF
Dim PDF_Range As Range
Set PDF_Range = WS.Range("A1:F44")

'This is designating the PO Number to be used in the saved file name and Email Subject
Dim PO_Number As Range
Set PO_Number = WS.Range("B7")

'This identifies the name of the PDF File
Dim PO_File As String
PO_File = "Cont Vrac P.O. " & PO_Number

'This Identifies the email adress in the Open P.O. Form
Dim Email As Range
Set Email = WS.Range("B11")

'This is the Scripy in the body of the Email
Dim BodyA As String
BodyA = "Hello" & vbNewLine & vbNewLine & "You Have Successfully Create a P.O." & vbNewLine & vbNewLine & "A copy has been included as an attachement in this Email" & vbNewLine & vbNewLine & "Thank You"

'This Designates where the file will be saved "N:\CVR\La Prairie Shared\commun\Accounting\MONTH END\Mark Test P.O\" + "Cont Vrac P.O. " is the file path on the drive and  + "Cont Vrac P.O. " & PO_Number.Value
'is the name of the file. The saved file will be called "Cont Vrac P.O. & the PO Number

Dim PDF_Path As String
PDF_Path = "N:\CVR\La Prairie Shared\commun\Accounting\MONTH END\Mark Test P.O\" + "Cont Vrac P.O. " & PO_Number.Value + ".pdf"

'Dim PDF_Attach As Object
'Set PDF_Attach = "N:\CVR\La Prairie Shared\commun\Accounting\MONTH END\Mark Test P.O\" + "Cont Vrac P.O. " & PO_Number.Value

'align Range in PDF
    WS.PageSetup.CenterHorizontally = True

'This is optional can be activated by switching False to true. it will open the PDF once the command is sent
    PDF_Range.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=PDF_Path, openAfterPublish:=False

'create email
    With xEmailObj
    .display
    .to = Email.Value
    .cc = ""
    .bcc = ""
    .Subject = "Cont Vrac P.O. " & PO_Number.Value
    .Body = BodyA
*.Attachements.Add 'THIS IS WHERE I CANNOT CONTINUE. I DO NOT KNOW WHAT TO INCLUDE HERE*

    xEmailObj.send


End With

Upvotes: 0

Views: 72

Answers (1)

Harun24hr
Harun24hr

Reputation: 37050

With below sample codes, you can send email with pdf attachment listed in range A2 to last non empty cell. You must change file path to match with your computer pdf files.

Public Sub SendMail()
On Error GoTo HarunErrHandler
Dim strbody As String
Dim sendTo As String
Dim emailCell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strMailRange As String

    strMailRange = Sheets("Open P.O. Form").Range("$A$2").End(xlDown).Address
    strbody = "Here is your email body text."
    
    For Each emailCell In Sheets("Open P.O. Form").Range("$A$2", strMailRange)
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
        With OutMail
'           .BodyFormat = olFormatHTML
            .Display
            .Attachments.Add ThisWorkbook.Path & "\PDF_Files\" & emailCell & ".pdf"
            .To = Range("B11").Value
            .Subject = "Here is email subject."
            .HTMLBody = strbody & vbNewLine & .HTMLBody
            '.Send
        End With
            
'        Application.Wait (Now + TimeValue("0:00:01"))
'        Application.SendKeys "%s"
    Next emailCell
        
Exit Sub
HarunErrHandler:
MsgBox "Error :" & Err.Number & ", " & Err.Description, vbInformation, "Error"
End Sub

Upvotes: 0

Related Questions