Multiple Select .docx then SaveAs .pdf then email

[smndnm]

Hello,
The intention here is to have a userform, fill in data, select a number of documents, populate those docs with data from the userform, save as .pdf.... and then attach those .pdf to an email without reselecting the files via a dialogue box.

The code here works... except for attaching the files to the email.


I can see there is a Filename.name associated in a For Next loop of .vrtSelectItems.
I am wondering how to keep the location/name data for use in the .Attachments.Add.

'the following part is from an existing project which MacroPod contributed greatly in 2014

Dim i As Long
Dim Fldr As String
Dim FileName As String
Dim vrtSelectedItem As Variant
Dim WordApp As Word.Application
Dim wdDoc As Word.Document
Dim wbXL As Excel.Workbook


'this part selects the destination folder

 With Application.FileDialog(msoFileDialogFolderPicker)
       .InitialFileName = "C:\Users\XYZ\Documents\SRC\SWMS Pack Demo Excel\Customers"
    .AllowMultiSelect = False
    .Title = "Select Destination Folder for the SWMS"
    If .Show = -1 Then
      Fldr = .SelectedItems(1)
    Else
      Exit Sub
    End If
End With
 MBxAns = MsgBox(Fldr, vbOKCancel, "The Destination Folder is...")
If MBxAns = vbCancel Then Exit Sub
 
'This part selects the target files for updating and saving as pdf in the selected folder

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "C:\Users\XYZ\Documents\SRC\SWMS Pack Demo EXCEL"
        .Title = "Select the Safety Templates"
        .AllowMultiSelect = True
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Set wdDoc = Documents.Open(FileName:=vrtSelectedItem)
                Set wbXL = ThisWorkbook
                
'This part specifies the Word Legacy Text Form Fields to be updated

                With wdDoc
                    .wdtxtbxSWMSNumber.Text = UserForm1.txtSWMSNumber.Text 'This is an ActiveX text box in the Header
                    .FormFields("wdfldProjectName").Result = UserForm1.txtProjectName.Text
                    .FormFields("wdfldPrimaryContract").Result = UserForm1.txtPrimaryContractor.Text
                    .FormFields("wdfldProjectAddress").Result = UserForm1.txtProjectAddress.Text
                    .FormFields("wdfldPreparedBy").Result = UserForm1.txtPreparedBy.Text
                    .FormFields("wdfldPreparedByDate").Result = UserForm1.txtDatePreparation.Text
                    .FormFields("wdfldPreparedFor").Result = UserForm1.txtPreparedForN.Text
                    .FormFields("wdfldDateSubmission").Result = UserForm1.txtDateSubmission.Text
                    .FormFields("wdfldOnsiteRep").Result = UserForm1.txtOnsiteRep.Text
                    .FormFields("wdfldReleasedBy").Result = UserForm1.txtAcceptedBy.Text
                    
'This part generates the new file name from the Excel userform data and a Word bookmark and the ActiveX Text Box

                    FileName = "SWMS " & .wdtxtbxSWMSNumber.Text & " " & _
                        .Bookmarks("SWMSType").Range.Text & " - " & _
                        .FormFields("wdfldPrimaryContract").Result & " - " & _
                        .FormFields("wdfldProjectName").Result
                        .BuiltinDocumentProperties("Title") = FileName
                        .BuiltinDocumentProperties("Subject") = .Bookmarks("SWMSType").Range.Text
                            With Dialogs(wdDialogFileSaveAs)
                            .Name = Fldr & "\" & FileName & ".pdf"
                            .Format = wdFormatPDF
                            .Execute
                            End With
                    .Close SaveChanges:=False
                End With
            Next
        End If
    End With

'this brings the msg box to foreground
AppActivate Application.Caption
    
    MsgBox "Please remember to secure the PDF before sending", vbExclamation, "Task Complete"
    Call Shell("explorer.exe " & Fldr, vbNormalFocus)
    'ActiveDocument.Close SaveChanges:=False

Set MailObject = Outlook.CreateItem(olMailItem)
    With MailObject
        .To = UserForm1.txtPreparedForE.Text
        .CC = ""
        .BCC = ""
        .Subject = "SRC Safety Pack Bundle for" & " " & UserForm1.txtPrimaryContractor.Text
        .Body = "Hello" & " " & UserForm1.txtPreparedForN.Text & "," & vbNewLine & vbNewLine
        '.Attachments.Add
        .Display
    End With

'this brings the msg box to foreground
AppActivate Application.Caption
MsgBox "Please remember to examine the attachments before sending", vbExclamation, "Bunny Check..."

'I am unsure about this but it seems it is required
Set SWMSsht = Nothing
Set HSRAsht = Nothing
Set PlantRAsht = Nothing
Set MailObject = Nothing




'ActiveWorkbook.Close SaveChanges:=True
'Unload Me

I can only take credit for copy paste from the internet and lots of guess work.
I am thinking I will need to loop through the .vrtSelectItems FileName.Name but the syntax and underpinning knowledge is beyond me.

A gentle nudge towards a solution will be appreciated.

Cheers
Simon

[smndnm]

I have a solution;
Create the MailObject prior to selecting the target folders then MailObject.Attachments.Add in the loop that updates and saves the pdfs using the string in .FileName.