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
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