How to attach PDF file in excel thru VBA code

[az365]

Hi all,

Just wondering how you can attach PDF file in email and send to the desire person via VBA ?

I want to automate the remittance advice process.

Much appreciated if anyone can help me with the issue.

AZ

 

[Logit]

.

Option Explicit


Sub PC_Email()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
    
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
  
   On Error GoTo cleanup
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "H").Value) <> "" Then
        
        
    With Application.ActiveSheet
        MailAttachments = Cells(cell.Row, "G").Value
    End With
        
    
    Set OutMail = OutApp.CreateItem(0)
        
            On Error Resume Next
                              
            With OutMail
            
            strbody = "Hi " & Cells(cell.Row, "B") & "," & vbNewLine & vbNewLine & _
              "The " & Cells(cell.Row, "A") & " ACH Remittance for " & Cells(cell.Row, "D") & " is attached." & vbNewLine & _
              "Please let me know if you have any questions." & vbNewLine & vbNewLine & _
              "Thanks," & vbNewLine & vbNewLine & _
              "Accounts Payable" & vbNewLine & "Reily Foods"
              
                .To = cell.Value
                .Subject = Cells(cell.Row, "A") & " ACH Remittance"
                .Body = strbody
               
                .Attachments.Add MailAttachments
                
                .Display  'Or use .Send
                  
                
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell




cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub


Sub ClrMailToSend()
    Sheets("Sheet1").Range("H2:H100").Clear
End Sub

Link to download sample workbook : https://www.amazon.com/clouddrive/share/bDbUSpcXvHFPGlSCkKX7LQV8Y21DNcyHvdl9b1htdhQ