G
Greg Strong
I'm no MS Word expert, but I've written a macro with some help from previous posts on
splitting a mail merge. I've taken it another step by installing GhostScript PDF
open source printing to PDF files from http://www.cs.wisc.edu/~ghost/ with Redmon
from http://www.cs.wisc.edu/~ghost/redmon/. This was an ideal that I have found from
Access automation and am attempting to convert and use on Word 2002. If you are
interested in the original post see comp.databases.ms-access Message-ID:
<[email protected]>. Thanks to CyranoVR. Thanks
to Doug Robbins and Graham Mayor for the splitting of the mail merge portion. I've
modified the mail merge splitting macro. The file name is placed on the merged
document, and cut and used for file saving and placed into an array.
The basic ideal is to take the mail merge and split it into separate Word documents.
Afterward I open the separate Word documents and print them using the GhostScript
Printer which outputs to x:\temp\output.pdf. After the printing I copy the
output.pdf file and rename for the final destination.
Everything works when I run the macro to curser at certain points in the code, but
when I run the full macro it hangs. It appears the code is moving forward on the copy
of the PDF output file from GhostScript to my destination path with the appropriate
name before the GhostScript printer finishes in code. The GhostScript printer works
fine when used in manual operation. When I halt the Word macro because it is hung, I
try to open the PDF files, and they are corrupt. So either my timer settings I'm
using are incorrect, or I must have something set up wrong in the GhostScript
configuration.
So if you have any ideals it would be appreciated. Thanks! The basics as follows:
I have set up GhostScript on WinXP Pro with the setup at
http://stat.tamu.edu/~henrik/GSWriter/GSWriter.html. Except I made some changes with
the printer re-directed ports from Redmon such as
- Output: "Program handles output"
- The new PDF file should always save to the same file i.e.
x:\temp\output.pdf
Use this for the "Program Arguments" setting:
@c:\gs\pdfwrite.txt -sOutputFile="C:\temp\output.pdf" -c .setpdfwrite
-f -
My pdfwrite.txt file is:
-IC:\gs\gs8.15\lib;C:\gs\fonts
-sDEVICE=pdfwrite
-r600
-dNOPAUSE
-dSAFER
-sPAPERSIZE=letter
-dCompatibilityLevel=1.4
-dPDFSETTINGS=/prepress
VB Word:
Option Explicit
Option Base 1
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Sub SplitterPDFRev2()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
' With minor modifications by Graham Mayor 10-02-03
' Modifications by GW on 1-7-04
Dim mask As String
Dim MyDataObj As New DataObject
Dim intLetters As Integer
Dim intCounter As Integer
Dim strDocName As String
Dim intArraySize As Integer
Dim strFileName() As String
Dim strOutputPathFile As String
Const PDF_PRINTER As String = "GS PDFWriter Auto"
Const ORIGINAL_PRINTER As String = "HP LaserJet 6P (Local)"
Const TEMP_PATH As String = "x:\temp\output.pdf"
Dim net
Dim fso As Scripting.FileSystemObject
Set net = CreateObject("WScript.Network")
net.SetDefaultPrinter PDF_PRINTER
Selection.EndKey Unit:=wdStory
intLetters = Selection.Information(wdActiveEndSectionNumber)
Debug.Print "intLetters = "; intLetters
intArraySize = intLetters - 1
Debug.Print "Array Size = "; intArraySize
ReDim strFileName(intArraySize)
Selection.HomeKey Unit:=wdStory
intCounter = 1
While intCounter < intLetters
ActiveDocument.Sections.First.Range.Cut
Documents.Add Template:= _
"C:\Documents and Settings\All Users\Templates\Word 2002\Letter.dot" _
, NewTemplate:=False, DocumentType:=0
Selection.Paste
Selection.EndKey Unit:=wdStory
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=1, Name:=""
Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=2, Name:=""
Selection.Find.ClearFormatting
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Cut
MyDataObj.GetFromClipboard
mask = MyDataObj.GetText()
strDocName = "X:\My Path\" & mask & ".doc"
strFileName(intCounter) = mask
Debug.Print "File Name from array is = "; strFileName(intCounter)
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.75)
.BottomMargin = InchesToPoints(0.75)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatDocument
ActiveWindow.Close
intCounter = intCounter + 1
Wend
'start of macro to reopen files and print to PDF
intCounter = 1
For intCounter = 1 To intArraySize
Debug.Print "intCounter in PDF loop is "; intCounter
Debug.Print "intArraySize in PDF loop is "; intArraySize
Documents.Open FileName:="X:\My Path\" _
& strFileName(intCounter) & ".doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
ActivePrinter = "GS PDFWriter Auto"
Application.PrintOut FileName:="X:\My Path\" _
& strFileName(intCounter) & ".doc", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages,
_
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:=
_
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
'DoEvents
Sleep 25000
ActiveWindow.Close
strOutputPathFile = "X:\My Path\" _
& strFileName(intCounter) & ".pdf"
Set fso = New Scripting.FileSystemObject
fso.CopyFile TEMP_PATH, strOutputPathFile, True
'DoEvents
Sleep 25000
Next intCounter
fso.DeleteFile TEMP_PATH
net.SetDefaultPrinter ORIGINAL_PRINTER
Set fso = Nothing
End Sub
splitting a mail merge. I've taken it another step by installing GhostScript PDF
open source printing to PDF files from http://www.cs.wisc.edu/~ghost/ with Redmon
from http://www.cs.wisc.edu/~ghost/redmon/. This was an ideal that I have found from
Access automation and am attempting to convert and use on Word 2002. If you are
interested in the original post see comp.databases.ms-access Message-ID:
<[email protected]>. Thanks to CyranoVR. Thanks
to Doug Robbins and Graham Mayor for the splitting of the mail merge portion. I've
modified the mail merge splitting macro. The file name is placed on the merged
document, and cut and used for file saving and placed into an array.
The basic ideal is to take the mail merge and split it into separate Word documents.
Afterward I open the separate Word documents and print them using the GhostScript
Printer which outputs to x:\temp\output.pdf. After the printing I copy the
output.pdf file and rename for the final destination.
Everything works when I run the macro to curser at certain points in the code, but
when I run the full macro it hangs. It appears the code is moving forward on the copy
of the PDF output file from GhostScript to my destination path with the appropriate
name before the GhostScript printer finishes in code. The GhostScript printer works
fine when used in manual operation. When I halt the Word macro because it is hung, I
try to open the PDF files, and they are corrupt. So either my timer settings I'm
using are incorrect, or I must have something set up wrong in the GhostScript
configuration.
So if you have any ideals it would be appreciated. Thanks! The basics as follows:
I have set up GhostScript on WinXP Pro with the setup at
http://stat.tamu.edu/~henrik/GSWriter/GSWriter.html. Except I made some changes with
the printer re-directed ports from Redmon such as
- Output: "Program handles output"
- The new PDF file should always save to the same file i.e.
x:\temp\output.pdf
Use this for the "Program Arguments" setting:
@c:\gs\pdfwrite.txt -sOutputFile="C:\temp\output.pdf" -c .setpdfwrite
-f -
My pdfwrite.txt file is:
-IC:\gs\gs8.15\lib;C:\gs\fonts
-sDEVICE=pdfwrite
-r600
-dNOPAUSE
-dSAFER
-sPAPERSIZE=letter
-dCompatibilityLevel=1.4
-dPDFSETTINGS=/prepress
VB Word:
Option Explicit
Option Base 1
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Sub SplitterPDFRev2()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
' With minor modifications by Graham Mayor 10-02-03
' Modifications by GW on 1-7-04
Dim mask As String
Dim MyDataObj As New DataObject
Dim intLetters As Integer
Dim intCounter As Integer
Dim strDocName As String
Dim intArraySize As Integer
Dim strFileName() As String
Dim strOutputPathFile As String
Const PDF_PRINTER As String = "GS PDFWriter Auto"
Const ORIGINAL_PRINTER As String = "HP LaserJet 6P (Local)"
Const TEMP_PATH As String = "x:\temp\output.pdf"
Dim net
Dim fso As Scripting.FileSystemObject
Set net = CreateObject("WScript.Network")
net.SetDefaultPrinter PDF_PRINTER
Selection.EndKey Unit:=wdStory
intLetters = Selection.Information(wdActiveEndSectionNumber)
Debug.Print "intLetters = "; intLetters
intArraySize = intLetters - 1
Debug.Print "Array Size = "; intArraySize
ReDim strFileName(intArraySize)
Selection.HomeKey Unit:=wdStory
intCounter = 1
While intCounter < intLetters
ActiveDocument.Sections.First.Range.Cut
Documents.Add Template:= _
"C:\Documents and Settings\All Users\Templates\Word 2002\Letter.dot" _
, NewTemplate:=False, DocumentType:=0
Selection.Paste
Selection.EndKey Unit:=wdStory
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=1, Name:=""
Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=2, Name:=""
Selection.Find.ClearFormatting
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Cut
MyDataObj.GetFromClipboard
mask = MyDataObj.GetText()
strDocName = "X:\My Path\" & mask & ".doc"
strFileName(intCounter) = mask
Debug.Print "File Name from array is = "; strFileName(intCounter)
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.75)
.BottomMargin = InchesToPoints(0.75)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatDocument
ActiveWindow.Close
intCounter = intCounter + 1
Wend
'start of macro to reopen files and print to PDF
intCounter = 1
For intCounter = 1 To intArraySize
Debug.Print "intCounter in PDF loop is "; intCounter
Debug.Print "intArraySize in PDF loop is "; intArraySize
Documents.Open FileName:="X:\My Path\" _
& strFileName(intCounter) & ".doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
ActivePrinter = "GS PDFWriter Auto"
Application.PrintOut FileName:="X:\My Path\" _
& strFileName(intCounter) & ".doc", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages,
_
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:=
_
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
'DoEvents
Sleep 25000
ActiveWindow.Close
strOutputPathFile = "X:\My Path\" _
& strFileName(intCounter) & ".pdf"
Set fso = New Scripting.FileSystemObject
fso.CopyFile TEMP_PATH, strOutputPathFile, True
'DoEvents
Sleep 25000
Next intCounter
fso.DeleteFile TEMP_PATH
net.SetDefaultPrinter ORIGINAL_PRINTER
Set fso = Nothing
End Sub