用于合并和附加PDF的Excel VBA运行时没有错误但未完成任务

Question

我已经成功编译了以下VBA代码，并为所有有用的人提供了大量帮助。它现在运行没有错误但由于某种原因合并部分只合并我的6行数据的前3行（将有更多的数据，所以我需要确保它合并一切，因为它不会那么容易看到未来）。 sub的最后一个循环似乎没有做任何事情，没有附加文件......有没有人知道我做错了什么？我迷路了！

Sub GenerateTAs()

Dim WeekFolder As String, YearFolder As String, ContentWeekFolder As String, Wc As String
Dim wdOutputName, wdInputName, PDFFileName As String
Dim x As Integer
Dim nRows As Integer
Dim wdDoc As Object
Dim i As Integer    
Dim InpUrl As String
Dim OutFilePath As String
Dim DownloadStatus As Long
Dim gPDDoc1 As AcroPDDoc
Dim gPDDoc2 As AcroPDDoc

YearFolder = "R:\TAs\" & Sheets("TAs").Range("Q1").Value
Wc = Format(Sheets("TAs").Range("Q3").Value, "dd.mm.yyyy")
WeekFolder = YearFolder & "\" & Wc
ContentWeekFolder = YearFolder & "\TA Content\" & Wc

If Dir(WeekFolder, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & WeekFolder & """")
End If
If Dir(ContentWeekFolder, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & ContentWeekFolder & """")
End If

wdInputName = "R:\TAs\TA Cover Sheet.docx"
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = 3

'This will get you the number of records "-1" accounts for header
With Worksheets("CoverSheetGen")
    nRows = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
End With

' open the mail merge layout file
Set wdDoc = GetObject(wdInputName, "Word.document")
wdDoc.Application.Visible = False

For x = 1 To nRows

    With wdDoc.MailMerge
         .MainDocumentType = wdFormLetters
         .Destination = wdSendToNewDocument
         .SuppressBlankLines = True
          With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
         .Execute Pause:=False
    End With
    With Worksheets("CoverSheetGen")
        PDFFileName = WeekFolder & "\" & Sheets("CoverSheetGen").Cells(x + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(x + 1, 9) & " - " & Sheets("CoverSheetGen").Cells(x + 1, 15) & " - " & Sheets("CoverSheetGen").Cells(x + 1, 6) & " - " & Sheets("CoverSheetGen").Cells(x + 1, 8) & ".pdf"
    End With
    With wdDoc.MailMerge.DataSource
         .ActiveRecord = x
         If .ActiveRecord > .LastRecord Then Exit For
    End With
    ' show and save output file
    'cells(x+1,2)references the first cells starting in row 2 and increasing by 1 row with each loop
    wdDoc.Application.Visible = False
    wdDoc.ExportAsFixedFormat PDFFileName, 17   ' This line saves a .pdf-version of the mail merge
Next x

' cleanup
wdDoc.Close SaveChanges:=FalseSet wdDoc = Nothing

With Worksheets("CoverSheetGen")
    cRows = .Range("H" & Rows.Count).End(xlUp).Row
End With
For i = 1 To cRows
    If Sheets("CoverSheetGen").Cells(i + 1, 1).Value <> "" Then
    'Read Input Path for the File and Output File Destination Path
    InpUrl = Sheets("CoverSheetGen").Cells(i + 1, 1).Value
    OutFilePath = ContentWeekFolder & "\" & Sheets("CoverSheetGen").Cells(i + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(i + 1, 15) & ".pdf"

    'Invoke API to download file from the website.
    DownloadStatus = URLDownloadToFile(0, InpUrl, OutFilePath, 0, 0)

    End If
Next i

For A = 1 To aRows
    Set gPDDoc1 = CreateObject("AcroExch.PDDoc")
    Set gPDDoc2 = CreateObject("AcroExch.PDDoc")

    If Dir(ContentWeekFolder & "\" & Sheets("CoverSheetGen").Cells(A + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 15) & ".pdf") <> "" Then

        chk1 = gPDDoc1.Open(WeekFolder & "\" & Sheets("CoverSheetGen").Cells(A + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 9) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 15) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 6) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 8) & ".pdf")
        chk2 = gPDDoc2.Open(ContentWeekFolder & "\" & Sheets("CoverSheetGen").Cells(A + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 15) & ".pdf")
        mergefile = gPDDoc1.InsertPages(0, gPDDoc2, 0, 1, 0)
        savemergefile = gPDDoc1.Save(1, WeekFolder & "\" & Sheets("CoverSheetGen").Cells(A + 1, 10) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 9) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 15) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 6) & " - " & Sheets("CoverSheetGen").Cells(A + 1, 8) & ".pdf")

    End If
Next A

End Sub

Function FileExist(path As String) As Boolean
    If Dir(path) <> vbNullString Then FileExist = True
End Function
Function IsFolderExists(txt As String) As Boolean
    IsFolderExists = _
        CreateObject("Scripting.FileSystemObject").FolderExists(txt)
End Function

非常感谢！