PDA

View Full Version : Merging Avery 5160 labels from excel to word



ashleygf
05-01-2015, 03:45 AM
I am attempting to merge contents from Excel 2013 to Avery 5160 labels in Word 2013. From 'start mail merge' I can achieve 30 labels per sheet manually. However, when I record and run a macro, using the same key strokes as when entering manually, the end result prints one label per page (30 pages) instead of 30 labels on the one sheet. Below is the recorded macro. I hope somebody can point me in the right direction and tell me where I am going wrong.
Regards.

Sub merge3()
'
' merge3 Macro
'
'
ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\Users\Ashley\Desktop\Addresses.xlsx", ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Ashley\Desktop\Addresses.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking " _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
ActiveDocument.Fields.Add Range:=Selection.Range, Type:= _
wdFieldAddressBlock, Text:= _
"\f ""<<_FIRST0_>><< _LAST0_>><< _SUFFIX0_>>" & Chr(13) & "<<_COMPANY_" & Chr(13) & ">><<_STREET1_" & Chr(13) & ">><<_STREET2_" & Chr(13) & ">><<_CITY_>><<, _STATE_>><< _POSTAL_>><<" & Chr(13) & "_COUNTRY_>>"" \l 1033 \c 2 \e ""Australia"" \d"
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
With ActiveDocument.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End Sub

ashleygf
05-01-2015, 04:41 PM
My apologies, I have reposted as I neglected to use code tags on original post and could not find facility to edit.



Sub merge3()
'
' merge3 Macro
'
'
ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\Users\Ashley\Desktop\Addresses.xlsx", ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Ashley\Desktop\Addresses.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking " _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
ActiveDocument.Fields.Add Range:=Selection.Range, Type:= _
wdFieldAddressBlock, Text:= _
"\f ""<<_FIRST0_>><< _LAST0_>><< _SUFFIX0_>>" & Chr(13) & "<<_COMPANY_" & Chr(13) & ">><<_STREET1_" & Chr(13) & ">><<_STREET2_" & Chr(13) & ">><<_CITY_>><<, _STATE_>><< _POSTAL_>><<" & Chr(13) & "_COUNTRY_>>"" \l 1033 \c 2 \e ""Australia"" \d"
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
With ActiveDocument.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End Sub