Word Macro to loop through next records

[shyy]

Hey guys,

I am having trouble with this macro. It loops but seems to loop and skip a record as it generates the word file. I am trying to create a mail merge where each record outputs its own .docx or .pdf.

Thanks in advance

Sub nextRecord()
Dim inputNumber As Long
Dim count As Long


inputNumber = InputBox("Input Number of Partners to loop")
count = ActiveDocument.MailMerge.DataSource.recordCount


'Partner = ActiveDocument.MailMerge.Fields("Partners").Value = .txtSurname


'print first page and subsequent using a loop


    Call runMacro
    Call UpdateAllFields
    
    'Printer
    'ActivePrinter = "Adobe PDF"
        'Application.PrintOut fileName:="", Range:=wdPrintAllDocument, Item:= _
        'wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
        'wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
        'PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        'PrintZoomPaperHeight:=0
        
    'PDF Printer
        'ActivePrinter = "Adobe PDF"
        'Application.PrintOut fileName:="", Range:=wdPrintAllDocument, Item:= _
        'wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
        'wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
        'PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        'PrintZoomPaperHeight:=0


MyCounter = 0


'loop


Do Until MyCounter = inputNumber


    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
    Call runMacro
    Call UpdateAllFields
    
    MsgBox (MyCounter)


    MyCounter = MyCounter + 1
     
     'Call fileName
Loop


End Sub

 

[Macropod]

You seem to be making hard work out of it. Try:

Sub Merge_To_Individual_Files()
'Merges one record at a time to the chosen output folder
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & "\"
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        StrName = .DataFields("Partners")
      End With
      .Execute Pause:=False
    End With
    With ActiveDocument
      .SaveAs2 FileName:=StrPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
      ' and/or:
      .SaveAs2 FileName:=StrPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With
  Next i
End With
Application.ScreenUpdating = True
End Sub

The above macro generates one output file per record. As coded, files are saved to the same folder as the mailmerge main document, using the ‘Partners’ field in the data source for the filenames. PDF & DOCX output formats are catered for.

 

[shyy]

Thank You so much!

Can't wait to try it at work tomorrow.

 

[shyy]

One more question, how would I modify this incase the partner name has a illegal char for a filename, replace illegal char with "-"?


StrName = .DataFields("Partners")

 

[Macropod]

To eliminate potentially illegal filenames:
• add another variable - j As Long
• add the following code after:

      .Execute Pause:=False
    End With

    For j = 1 To 255
      Select Case j
        Case 1 To 31, 33 To 45, 47, 58 To 64, 91 To 94, 96, 123 To 141, 143 To 149, 152 To 157, 160 To 180, 182 To 191
        StrName = Replace(StrName, Chr(j), "")
      End Select
    Next
    StrName = Trim(StrName)

 

[shyy]

Works flawlessly!

thanks again!

the code is so clean and easy to learn