Sub Nexum_Print() 'Macro Created by Jxxxx
Dim path
Dim reminder As Integer
Dim oExtension As String
Dim Fso, oFolder, oSubfolder, oFile, queue As Collection

On Error Resume Next

path = " /Users/Shared/Mailmerge/"

If optionCancel = "yes" Then
optionCancel = "No"
Exit Sub
End If

reminder = MsgBox("Are you sure you want to print these files?", 4, "WARNING !!")

If reminder = 6 Then    'If Yes is clicked

Set Fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add Fso.GetFolder(path) 'The path

Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue
'...insert any <<folder>> processing code here...
For Each oSubfolder In oFolder.subfolders
queue.Add oSubfolder 'enqueue
Next oSubfolder
For Each oFile In oFolder.Files

oExtension = Right(oFile, Len(oFile) - InStrRev(oFile, ".", -1)) 'gets the file extension

If oExtension = "docx" Or oExtension = "DOCX" Or oExtension = "doc" Or oExtension = "DOC" Or oExtension = "docm" Or oExtension = "DOCM" Or oExtension = "rtf" Or oExtension = "RTF" Then

Documents.Open FileName:=(oFile)

'-------------------This part then prints the individual letters in that file -------------------------

    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdSectionBreakNextPage
Dim Letters As Long
Dim Counter As Long
Letters = ActiveDocument.Sections.Count
Counter = 1
While Counter < Letters
ActiveDocument.PrintOut Background:=False, _
Range:=wdPrintFromTo, _
From:="s" & Format(Counter), To:="s" & Format(Counter)
Counter = Counter + 1
Wend
     'Prints document

ActiveDocument.Saved = True  'to prevent asking to save

ActiveDocument.Close         'Closes document

'-------------------End of individual letter printing part---------------------------------------

End If

Next oFile

Loop

Else

MsgBox ("Operation cancelled!!")

End If

End Sub