Private Sub CommandButton1_Click()
Dim MBxAns
Dim i As Long
Dim Fldr As String
Dim StrNm As String
Dim vrtSelectedItem As Variant
Dim wdDoc As Document
 MBxAns = MsgBox("Did you update the SWMS Number?", vbYesNo, "Bunny Check...")
If MBxAns <> vbYes Then Exit Sub
 With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "G:\Admin - MASTER\Customers\"
    .AllowMultiSelect = False
    .Title = "Select Destination Folder for the SWMS"
    If .Show = -2 Then Exit Sub
    Fldr = .SelectedItems(1)
End With
 MBxAns = MsgBox(Fldr, vbOKCancel, "The Destination Folder is...")
If MBxAns = vbCancel Then Exit Sub
 
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "G:\QMS\OH&S"
        .Title = "Select the SWMS Templates"
        .AllowMultiSelect = True
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Set wdDoc = Documents.Open(FileName:=vrtSelectedItem)
                With wdDoc
                    .Fields.Update
                    StrNm = "SWMS " & .Bookmarks("SWMSNumber").Range.Text & " " & _
                        .Bookmarks("SWMSType").Range.Text & " - " & _
                        .Bookmarks("PrimaryContractor").Range.Text & " - " & _
                        .Bookmarks("ProjectName").Range.Text
                        .BuiltInDocumentProperties("Title") = StrNm
                        .BuiltInDocumentProperties("Subject") = .Bookmarks("SWMSType").Range.Text
                    With Dialogs(wdDialogFileSaveAs)
                        .Name = Fldr & StrNm & ".pdf"
                        .Format = wdFormatPDF
                        .Show
                    End With
                    .Close SaveChanges:=False
                End With
            Next
        End If
    End With
    MsgBox "remember to secure the PDF before sending"
    'ActiveDocument.Close SaveChanges:=False
End Sub