VBA使用Mailmerge字段中的密码将Word文档打印为PDF

问题描述

我正在对大型excel数据集执行邮件合并练习。我需要将Word文档中的PDF与各个密码合并-密码是我的excel文件中的一个字段。

以下我的代码要求批号和位置。我在Excel文件中有某些行与该批次号匹配。我在下面运行并成功打印了输入的批次,但是我对如何在PDF上放置单个密码感到困惑。任何帮助将不胜感激。我使用PDF-XChange作为通常用于在单个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

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)