Hello All!
I hope someone can help...
I had a Macro that ran flawlessly on a PC that worked like this:
1) Accessed a directory on my PC and opened 1 document at a time from that directory
2) Broke that open doc down into individual letters (as each doc contained up to 10 letters)
3) Printed each individual letter at a time
4) Once compelted all letters in that active document, closed it and opened the next
5) Repeated until every file in that directory had been broken down and printed.
We're now moving over to Mac's and the Macro no longer works properly, it stops after asking the user if they are sure they want to print all the files.
Has anyone got any ideas why? (Copy of the code is below)
Thanks!
James
Code:
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