Here is the code for the function. Hope there is a modicum of clarity.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub JOCLabels()
'
' Use Word MailMerge to write out labels from data in the Labels Data
' worksheet of JOCMembership.xls workbook.
'
' NOTE: Uses the LabelLayout.doc file.
'
' Make copy of Label Data to new temporary tempLabelsWks.xls file
' because can't access it from the open JOCMembership.xls workbook
'
Sheets("Label Data").Select
Sheets("Label Data").Copy
ChDir "D:\JOC\Membership"
ActiveWorkbook.SaveAs
fileName:="D:\JOC\Membership\tempLabelsWks.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
'
' Now use Word to write the label images file.
'
Dim wdApp As Word.Application
Set wdApp = New Word.Application
On Error Resume Next
With wdApp
ChangeFileOpenDirectory "D:\JOC\Membership\"
.Documents.Open fileName:="LabelLayout2.doc",
ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
ActiveDocument.MailMerge.OpenDataSource Name:= _
"D:\JOC\Membership\tempLabelsWks.xls",
ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True,
AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="",
WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False,
Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User
ID=Admin;Data
Source=D:\JOC\Membership\tempLabelsWks.xls;Mode=Read;Extended
Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDB
atabase Password="""";Jet
OLEDB:Eng" _
, SQLStatement:="SELECT * FROM `'Label Data$'`",
SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
'
' Delete the temporary workbook file
'
Kill ("D:\JOC\Membership\tempLabelsWks.xls")
ActiveDocument.SaveAs fileName:="testLabels.doc", FileFormat:=
_
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False,
SaveFormsData:=False, _
SaveAsAOCELetter:=False
End With
On Error GoTo 0
'wdApp.Quit
Set wdApp = Nothing
End Sub
-----------------------------------------------------------------------------------------------