Macro send multiple pdf per mail.

[martinus1988]

Hi all,

The macro is as follows: a sheet is made and then saved as xlsx and pdf. Then outlook opens and set (only) the pdf as attachment. However i have more then 1 attachment. So the first 1 is made of an excel sheet and autopasted in the new mail. Te rest are manuals and are already in PDF. I made a list of the locations in the B colom. How do i add those files?

B colom:
[TABLE="width: 583"]
<colgroup><col></colgroup><tbody>[TR]
[TD]R:\Verkoop\Martijn\PDF\test.pdf
[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test2.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test3.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test2.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test3.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test2.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test3.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test2.pdf[/TD]
[/TR]
[TR]
[TD]R:\Verkoop\Martijn\PDF\test3.pdf[/TD]
[/TR]
</tbody>[/TABLE]


See code:

Option Explicit

Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail2()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If

    'Call the function with the correct arguments
    'Tip: You can also use Sheets("YourSheetName") instead of ActiveSheet in the code(sheet not have to be active then)

    FileName = RDB_Create_PDF(Source:=ActiveSheet, _
                              FixedFilePathName:="R:\Verkoop\Martijn\Offertes\" & ThisWorkbook.Sheets("Medewerkers").Range("I12").Value & ThisWorkbook.Sheets("Medewerkers").Range("I13").Value & ThisWorkbook.Sheets("Medewerkers").Range("I14").Value & ".pdf", _
                              OverwriteIfFileExist:=True, _
                              OpenPDFAfterPublish:=False)

    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                             StrTo:=ThisWorkbook.Sheets("Offerte").Range("D12").Value, _
                             StrCC:="", _
                             StrBCC:="sales@hollandaviation.com", _
                             StrSubject:="Requested quotation " & Sheets("Offerte").Range("H7").Value, _
                             Signature:=True, _
                             Send:=False, _
                             StrBody:="[B][B]Dear " & Sheets("Offerte").Range("D7").Value & "[/B][/B]


" & _
                                      "Thank you for your interest in XXXX." & _
                                      "

" & "We have made the quotation you asked for. please check attachment." & _
                                      "

" & "If you have further question, then please let us know."
    'Zet de Send:=True, _) aan om mnail gelijk te verzenden!

    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub