I was going out today, but it is raining, so I have come up with the
following. It requires an envelope template that you can download from my
web site. It also requires that you define the address location on the
envelope. My letter templates use the built-in Inside Address paragraph
style to format the addressee information so the address is easy to locate.
Yours I don't know about.
The macro is annotated to show how it works.
Do not even think of running the macro on a folder that contains anything
other than your letters!
Sub BatchPrintEnvelopes()
'Macro requires Envelope #10.dot
'Download from
www.gmayor.com
'and extract to the user templates folder
Dim oEnvelope As Document
Dim oAddress As Range
Dim oRng As Range
Dim oVars As Variables
Dim EnvAddress As String
Dim i As Long
Dim strFile As String
Dim strPath As String
Dim strDoc As Document
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
'The envelope template contains automacros, not required
'by this macro, so start by disabling them
WordBasic.DisableAutoMacros 1
With fDialog 'Select the folder containing the letters
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then 'Close any open documents
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
'Open an envelope document. The one shown is based on
'Envelope #10.dot
Set oEnvelope = Documents.Add(Template:= _
Options.DefaultFilePath(wdUserTemplatesPath) & _
"\Envelope #10.dot", _
NewTemplate:=False, _
DocumentType:=0)
Set oVars = ActiveDocument.Variables
strFile = Dir$(strPath & "*.do?")
'The Envelope #10.dot template includes a bookmark called Address
'in the addressee section. Locate this bookmark and insert
'a Docvariable field caleld vAddress and add a charformat switch
With Selection
.GoTo What:=wdGoToBookmark, Name:="Address"
.Fields.Add Selection.Range, wdFieldDocVariable, _
"""vAddress"" \*Charformat", False
End With
'Open each document from the selected folder
'Use a folder that ONLY contains documents for which
'Envelopes are required
While strFile <> ""
Set strDoc = Documents.Open(strPath & strFile)
'Define the location of the address on the envelope.
'In this example, the address starts at the second paragraph
Set oAddress = strDoc.Paragraphs(2).Range
'Check the next few paragraphs to see if they are formatted
'the 'Inside Address' paragraph style and if so add them to
'the address range
For i = 2 To 9
If strDoc.Paragraphs(i).Style = "Inside Address" Then
oAddress.End = strDoc.Paragraphs(i).Range.End
End If
Next i
oAddress.End = oAddress.End - 1
'If InStr(1, oAddress, Chr(13)) Then
' oAddress = Replace(oAddress, Chr(13), Chr(11))
'End If
'Add the address range to the docvariable which will
'Be used to display the address on the envelope
With oEnvelope
oVars("vAddress").Value = oAddress
.Fields.Update 'Update the docvariable field
.PrintOut 'Print the envelope
End With
'Close the letter document and repeat until all the documents
'have been processed
strDoc.Close wdDoNotSaveChanges
strFile = Dir$()
Wend
CleanUp:
'Restore the automacro function
WordBasic.DisableAutoMacros 0
'Close the envelope
oEnvelope.Close wdDoNotSaveChanges
End Sub
http://www.gmayor.com/installing_macro.htm
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
