'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