VBA Print Word Doc as PDF with password from Mailmerge Field

Question

I am performing a mail merge exercise on a large excel data set. I need to merge PDFs from a word document with individual passwords - the password being a field in my excel file.

My code below requests a batch number and a location. I have certain rows matched up to that batch number in the excel file. I have the below running and successfully printing the batches I enter but I'm at a loss as to how to put individual passwords on the PDFs. Any help would be greatly appreciated. I have PDF-XChange as the program I'd normally use to put a password on an individual PDF.

Sub Merge_To_Individual_PDF()

'
' Merge_To_Individual_PDF Macro
'
'
Application.ScreenUpdating = True
Dim StrFolder As String, StrName As String, MainDoc As Document, TargetDoc As Document, i As Long, j As Long, K As String, Newfolder As String, MyFolder As String, L As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
K = "Errors"
'Batch to Print
myValue = InputBox("Batch Number")
If StrPtr(myValue) = 0 Then Exit Sub
If myValue = "" Then Exit Sub
If TypeName(myValue) = "Boolean" Then Exit Sub
MyFolder = InputBox("Copy Paste Local File Location Here")
With MainDoc
'Folder name
  If MyFolder = "" Then
  StrFolder = "C:\Users\Mathun\test\"
  Else: StrFolder = MyFolder & "\"
  End If
  L = 0
  Application.StatusBar = L
  With .MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    On Error Resume Next
   For i = 1 To .DataSource.RecordCount
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Pack_Ref")) = "" Then Exit For
        StrName = .DataFields("Pack_Ref")
         'Only print this batch
        If .DataFields("BatchNumber") <> myValue Then GoTo NextRecord
       
        
      End With
      .Execute Pause:=False
      If Err.Number = 5631 Then
        Err.Clear
        K = K & StrName
        GoTo NextRecord
      End If
      Newfolder = StrFolder & myValue
      MkDir Newfolder
      
        StrName = Trim(StrName)
               With ActiveDocument
        Selection.WholeStory
        ActiveDocument.Fields.ToggleShowCodes
        Selection.Fields.Update
        ', Password:=StrName
        ActiveDocument.SaveAs2 FileName:=StrFolder & myValue & "\" & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close
        L = L + 1
        'and/or:
        ActiveDocument.SaveAs2 FileName:=StrFolder & myValue & "\" & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
        
        End With
NextRecord:
    Next i
  End With
End With
Application.ScreenUpdating = True
End Sub