Mail Merge from Excel to Word Labels

[antthorne]

Hi

Wonder if anyone can help, I find some help on youtube on how to get this working. It appears to work but I don't think it stops at the end of my data as in when i = "". Can anyone help??

The code is below

Sub LabelMerge()Dim oword As Word.Application, odoc As Word.Document
Dim sPath As String, i As Integer, oHeaders As Range
Set oHeaders = Range("a1").CurrentRegion.Rows(1)
sPath = ThisWorkbook.FullName
Set oword = CreateObject("Word.Application")
Set odoc = oword.Documents.Add
oword.Visible = True
odoc.Activate
odoc.MailMerge.MainDocumentType = wdMailingLabels
oword.Dialogs(wdDialogLabelOptions).Show
With odoc.MailMerge.Fields
 For i = 1 To oHeaders.Columns.Count
    .Add oword.Selection.Range, oHeaders.Cells(1, i)
    oword.Selection.Font.Name = "ABC C39 SHORT"
    oword.Selection.Font.Size = 28
    oword.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    oword.Selection.TypeParagraph
    Next i
End With
odoc.MailMerge.OpenDataSource sPath
oword.WordBasic.mailmergepropagatelabel
odoc.MailMerge.ViewMailMergeFieldCodes = False
odoc.ActiveWindow.View.ShowFieldCodes = False
odoc.MailMerge.Destination = wdSendToNewDocument
odoc.MailMerge.Execute
Set odoc = Nothing
Set oword = Nothing
End Sub

Any help would be very much appreciated

Thanks

Ant

 

[jsotola]

seems to work for me

run this

added command to show number of columns

Sub LabelMerge()


    Dim oword As Word.Application, odoc As Word.Document
    Dim sPath As String, i As Integer, oHeaders As Range
    
    Set oHeaders = Range("a1").CurrentRegion.Rows(1)
    
    sPath = ThisWorkbook.FullName
    
    Set oword = CreateObject("Word.Application")
    Set odoc = oword.Documents.Add
    
    oword.Visible = True
    odoc.Activate
    odoc.MailMerge.MainDocumentType = wdMailingLabels
    oword.Dialogs(wdDialogLabelOptions).Show
    
[COLOR=#ff0000]    MsgBox oHeaders.Columns.Count[/COLOR]
    
    With odoc.MailMerge.Fields
     For i = 1 To oHeaders.Columns.Count
        .Add oword.Selection.Range, oHeaders.Cells(1, i)
        oword.Selection.Font.Name = "ABC C39 SHORT"
        oword.Selection.Font.Size = 28
        oword.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        oword.Selection.TypeParagraph
        Next i
    End With
    
    odoc.MailMerge.OpenDataSource sPath
    oword.WordBasic.mailmergepropagatelabel
    odoc.MailMerge.ViewMailMergeFieldCodes = False
    odoc.ActiveWindow.View.ShowFieldCodes = False
    odoc.MailMerge.Destination = wdSendToNewDocument
    odoc.MailMerge.Execute
    
    Set odoc = Nothing
    Set oword = Nothing
End Sub

 

[antthorne]

Hi jsotola

Thanks for your reply

I should have been clearer in my question, the problem I'm facing is with the amount of rows rather than columns, I think (I could be wrong) that I need to place somewhere in the macro an end point as I seem to be getting a lot of blank data. Is their a way to set a dynamic range with regards to i??

Thanks
Ant