strXLWbk = ActiveDocument.MailMerge.DataSource.Name
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Excel Is Nothing Then
Set Excel = CreateObject("Excel.Application")
Set wkbkXLBook = Excel.Workbooks.Open(strXLWbk)
Else
For Each tmpWkbk In Excel.Workbooks
If StrComp(tmpWkbk.FullName, strXLWbk, vbTextCompare) = 0 Then
Set wkbkXLBook = tmpWkbk
Exit For
End If
Next tmpWkbk
If wkbkXLBook Is Nothing Then
Set wkbkXLBook = Excel.Workbooks.Open(strXLWbk)
End If
End If
Set wkSheet = wkbkXLBook.Worksheets(1)