Microsoft Office Tutorials and References
In Depth Information
Creating Custom Mail Merge Using Data in Excel Worksheet
'Using activesheet¶
Set sht = ActiveSheet¶
'Set data range¶
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp))¶
'Create new word application¶
Set wrdApp = CreateObject("Word.Application")¶
'Create new document¶
Set objDoc = wrdApp.Documents.Add¶
'Loop in data range¶
For Each cll In rng.Cells¶
'Retrieve file name - 6 columns from the first column¶
strFileName = cll.Offset(, 6).Value¶
'If file name doesn't include path information¶
'then use this workbook's path by assuming the merge files¶
'are saved in this folder¶
If InStr(strFileName, "\") = 0 Then¶
strFileName = ThisWorkbook.Path & "\" & strFileName¶
End If¶
'Insert requested file into the main document¶
wrdApp.Selection.InsertFile strFileName¶
'Find all bookmarks and put the corresponding values¶
'for these bookmarks¶
For Each objBookMark In objDoc.Bookmarks¶
'Corresponding header found in first row ?¶
Set fnd = sht.Rows(1).Find(objBookMark.Name, LookIn:=xlValues, _¶
If Not fnd Is Nothing Then¶
'Data column is found. Put date instead bookmark¶
'this action also removes bookmark¶
'so new inserted document's bookmark will be the¶
'unique bookmark¶
objBookMark.Range.Text = cll.Offset(, fnd.Column - 1).Value¶
End If¶
Next objBookMark¶
'Goto next page¶
'wdPageBreak = 7¶
wrdApp.Selection.InsertBreak 7¶
Next cll¶
'wdStory = 6¶
'Goto begining of the document¶
wrdApp.Selection.HomeKey 6¶
'Display word document¶
wrdApp.Visible = True¶
End Sub¶
Create Word documents with bookmarks for the fields that will be merged.
Search JabSto ::

Custom Search