View Single Post
 
Old 01-09-2020, 02:32 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

If you have a merge document that comprises a collection of merged letters, then each letter in that document is a Word section. It is thus simple to grab the address from each section and apply it to an envelope and print that envelope using a macro.

The only information required are the numbers of the paragraphs where the address is located in the document, and the location of the envelope used to perform the print task, which should replace the three values at the start of the macro as appropriate. Installing Macros

I have attached a suitable envelope document. If you don't want the airmail logo, delete it from the envelope before running the macro.

Code:
Sub PrintEnvelopes()

'Graham Mayor - https://www.gmayor.com - Last updated - 09 Jan 2020

Const lngStart As Long = 1    'The number of the first paragraph of the address
Const lngEnd As Long = 6    'The number of the last paragraph of the address
Const strEnvelope As String = "C:\Path\Envelope.docx" 'The location of the envelope document

Dim lngSec As Long
Dim oDoc As Document, oEnv As Document
Dim oCC As ContentControl
Dim oRng As Range
    
    Set oDoc = ActiveDocument
    Set oEnv = Documents.Open(FileName:=strEnvelope)
    For lngSec = 1 To oDoc.Sections.Count
        If lngSec = oDoc.Sections.Count Then
            If Len(oDoc.Sections(lngSec).Range) = 1 Then GoTo lbl_Exit
        End If
        Set oRng = oDoc.Sections(lngSec).Range
        oRng.Start = oDoc.Sections(lngSec).Range.Paragraphs(lngStart).Range.Start
        oRng.End = oDoc.Sections(lngSec).Range.Paragraphs(lngEnd).Range.End
        Set oCC = oEnv.SelectContentControlsByTitle("Address").Item(1)
        oCC.Range.Text = oRng.Text
        oEnv.PrintOut
    Next lngSec
    oEnv.Close 0
lbl_Exit:
    Set oDoc = Nothing
    Set oEnv = Nothing
    Set oCC = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub
Attached Files
File Type: docx Envelope.docx (81.0 KB, 9 views)
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote