VBA: Meerdere PDF bijlagen samenvoegen tot 1 PDF bestand in een email

[hennie2504]

Goedendag allemaal,

Ten eerst hartstikke bedankt op voorhand voor iedereen die een blik werpt op deze post!

Probleemstelling / doel:
Momenteel ontvang ik op grote schaal emails met hierin één factuur en één of twee werkbonnen die betrekking hebben op de eerder genoemde factuur. Het is nu erg veel werk om per email de aanwezige bijlagen samen te voegen tot één document. Het uitgangspunt voor deze macro is dat elke email betrekking heeft op één factuur. Of kortom gezegd alle PDF documenten in een email mogen samen worden gevoegd en is onafhankelijk van bestandsnamen.

In het verleden heb ik ooit eens een marco (m.b.v. andere topics) gemaakt in Outlook die door emails heen loopt en alle bijlagen opslaat in een opgegeven directory. Nu zou ik graag dus onderstaande macro uit willen breiden met de wens die bij de doelstelling hierboven is aangegeven.

Macro die door de emails heen loopt:

'VBA script om bijlagen op te slaan Q-schijf

On Error GoTo GetAttachments_err

'Hier worden de variabelen gedefineeerd
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim Gebruiker As String
Dim varResponse As VbMsgBoxResult
Dim SubFolder As MAPIFolder

Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("Map XXXX").Folders("Postvak IN")
Set SubFolder = Inbox.Folders("Map XXXX")

i = 0

'Hier wordt er gekeken of er berichten zijn in het postvak XXXXX
If SubFolder.Items.Count = 0 Then
   MsgBox "There are no messages in the Sales Reports folder." _
   , vbInformation, "Niets gevonden!"
   Exit Sub
End If


'Hier wordt in elk bericht gekeken of er een PDF bijlage aanwezig is
If SubFolder.Items.Count > 0 Then
   For Each item In SubFolder.Items
      For Each Atmt In item.Attachments
        If Right(Atmt.FileName, 3) = "PDF" Then
         FileName = "M:\XXXXXX\" & Atmt.FileName
         Atmt.SaveAsFile FileName
         i = i + 1
         End If
      Next Atmt
   Next item
End If
    
'Geeft de resultaten weer, dus hoeveel bestanden er zijn opgeslagen!
If i > 0 Then
        varResponse = MsgBox("Er zijn " & i & " bijlagen gevonden." _
        & vbCrLf & "Ze zijn opgeslagen op de Q-schijf" _
        & vbCrLf & vbCrLf & "Wil je ze bijlagen bekijken?" _
        , vbQuestion + vbYesNo, "Klaar!")
'Opent de bestandsmap
        If varResponse = vbYes Then
         MsgBox "Dit is nog onder constructie!"
        End If
Else
        MsgBox "Er zijn geen bijlagen gevonden!", vbInformation, "Klaar!"
End If


'Zorgt ervoor dat het geheugen wordt leeggemaakt (betere performance)
GetAttachments_exit:
    Set Atmt = Nothing
    Set item = Nothing
    Set ns = Nothing
    Exit Sub
    
'Foutmeldingen afvangen, hier word de foutcode makkelijk getoond!
GetAttachments_err:
   MsgBox "Er is een fout opgetreden!" _
      & vbCrLf & "Geef de volgende informatie door aan de beheerder:" _
      & vbCrLf & "Macro Name: GetAttachmentsMcDCSN" _
      & vbCrLf & "Error Number: " & Err.Number _
      & vbCrLf & "Error Description: " & Err.Description _
      , vbCritical, "Error!"
   Resume GetAttachments_exit


End Sub

Om te mergen heb je third party nodig en in mijn geval is dit Adobe Acrobat. Ik heb uiteraard al druk gezocht in andere topics en veelbelovende topics waren o.a.:

1. 
   
   1.http://www.vbaexpress.com/forum/sho...-email-body-Code-works-but-need-a-little-help
   
   2 .https://stackoverflow.com/questions/51389983/vba-combine-pdfs-into-one-pdf-file

Echter krijg ik het niet voor elkaar om alles in elkaar te passen en loop al een tijdje vast.

Zou iemand van jullie mij verder op weg kunnen helpen? Als er aanvullende info nodig is hoor ik dit natuurlijk graag!

Alvast super bedankt.