Mail Merge from Excel Issue

[Beacho]

Hi,

I have a problem with VBA mail merging. I have a word document which is set up to mail merge, and the data for that mail merge is in the current workbook "Book1.xls". The code below works file and leaves no error messages. The problem i have is that each time the workbook is opened, and the macro is run it leaves a new VBA Project in the project explorer. I think that something isn't closing, because when i close excel and check the task manager, the excel application is closed but the Excel.exe process is still running. The only way around this i've found to be either 1) opening the task manager and ending the process; 2) don't open the file Book1.xls from windows explorer, but open excel and then file open method; 3) restarting the machine altogether.

Hope someone out there can help! Any help will be greatly appreciated.

Private Sub CommandButton01_Click()

Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String

On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wdocSource = wd.Documents.Open(Filename:=ThisWorkbook.Path & "\Mailmergedocument.doc")

strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

wdocSource.MailMerge.MainDocumentType = wdFormLetters

wdocSource.MailMerge.OpenDataSource _
        Name:=strWorkbookName, _
        AddToRecentFiles:=False, _
        Revert:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM `Merge Info$`"

With wdocSource.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
End With

With wdocSource

.MailMerge.MainDocumentType = wdNotAMergeDocument

End With

wd.Visible = True
wdocSource.Close SaveChanges:=False

Set wdocSource = Nothing
Set wd = Nothing

End Sub