create multiple envelopes from outlook contacts

[Sabi S via OfficeKB.com]

My code is as follows:I am able to retrieve contacts but print only 1
envelope not multiple please help me...I have been struggling over this ...
can u suggest some modifications...thx

Set myOlApp = CreateObject("Outlook.Application")
Set objWordApp = CreateObject("Word.Application")
Set objWordDoc = objWordApp.Documents.Add
objWordDoc.MailMerge.MainDocumentType = wdEnvelopes

For i = 1 To fldFolder.Items.Count

Set Contact = Outlook.Session.GetDefaultFolder(10).Items(i)
a = Contact.Email1Address
If bb = True Then
For k = 0 To List1.ListCount - 1
If a = List1.List(k) Then
r = Contact.FullName
v = Contact.BusinessAddress

'addr has the size of envelope
addr = Combo1.Text
ice = Left(addr, Len(addr) - InStr(addr, "("))
sp = Trim(ice)
objWordDoc.Envelope.DefaultSize = sp
objWordDoc.Envelope.Insert Address:=r & Chr(10) & v, ReturnAddress:
=txtAddress.Text
With objWordDoc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

End With
objWordDoc.ActiveWindow.View.Type = wdPrintView
objWordApp.WindowState = wdWindowStateMaximize

End If
Next k
End If
Next i