Create and Mail PDF to multiple Recipient saved in Folder

[Nishant859_1]

Hello Experts,

I have attached on Excel Template
there i trying to create Customer/Vendor Wise PDF & saved in folder
after saving the PDF,
I would like to send that PDF file saved in Folder to each customer/vendor email id mentioned in master sheet

I have completed PDF creation & saved in Folder (after searching so much blogs)
but would like to know, can i use any Letter Head saved in Word Format in any location in which i can get the Customer/vendor wise data

and

Part 2 :- Sending PDF saved in Folder is completely pending

& also pls let me knoe any addon need to add
i am using office 2016

please help

New​

& also please let me know any Add-on need to add
i am using office 2016​

 

[Kenneth Hobson]

I don't know what you mean by Word letterhead. Excel has PageSetup where you can do a header.

I don't see any email addresses. While you may have at least one record/row for each vendor/id from that master list, in normal practice, most don't.

See if this code gives you some ideas. The commented link shows where you can get more code and examples for Outlook at Ron de Bruin's site. Of course one can use CDO for email but i don't know of one just for Gmail. Outlook and CDO has always worked for my Gmail.

'http://www.vbaexpress.com/forum/showthread.php?60661-Help-on-filtering-an-excel-based-Column-C-and-send-email-for-every-filtered-item
Sub Main()
  Dim ws As Worksheet, sws As Worksheet, a(), e
  'Add reference: Microsoft Outlook xx.x Library, where xx.x is 14.0, 15.0, 16.0, etc.
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  Set olApp = New Outlook.Application
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False
  'Worksheet to filter and email
  Set ws = Worksheets("Sheet1")
  'Create and set a temporary scratch worksheet
  Set sws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
  'Make unique array of values in column C.
  With ws
    a() = .Range("C2", .Cells(Rows.Count, "C").End(xlUp)).Value
    a = UniqueArrayByDict(a())
    'Turn on autofilter
    .Range("A1").AutoFilter
  End With
  'Filter and Email each set of data.
  For Each e In a()
    ws.Range("A1:G8").AutoFilter Field:=3, Criteria1:=e
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
      .To = e & ".gmail.com"
      .Subject = "Case Report Dated: " & Format(Date, "mm/dd/yyyy")
      ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy
      sws.Range("A1").PasteSpecial xlPasteAll
      .HTMLBody = RangetoHTML(sws.UsedRange)
      sws.UsedRange.Clear
      '.Display
      .Send
    End With
  Next e
  'Cleanup
  'Turn off autofilter
  ws.Range("A1").AutoFilter
  sws.Delete
  Set olMail = Nothing
  Set olApp = Nothing
  Application.CutCopyMode = False
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.DisplayAlerts = True
End Sub

'http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


' http://www.excelforum.com/excel-programming-vba-macros/819998-filter-and-sort-scripting-dictionary.html
'Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d() As Variant, Optional compareMethod As Integer = 0) As Variant
  'Dim dic As Object 'Late Binding method - Requires no Reference
  'Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  Dim dic As Dictionary     'Early Binding method
  Set dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not dic.Exists(e) Then dic.Add e, Nothing
  Next e
  UniqueArrayByDict = dic.Keys
End Function