Excel mail merge macro print error

[VbaNewbie08]

The excel mail merge code below runs fine, but for some reason excel default printer wont work once the macro is finished. The only way to fix it is got to windows change default to another printer and change default back. Any help would be appreciated as i'm some what still new to this.

Sub RunMerge()

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("P:\Accounts_Payable\Maps Data Import\Labels\Labels.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 `Labels$`"
wd.ActivePrinter = "\\d922418\HP LaserJet 4 - CABS"
With wdocSource.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With

wd.Visible = True
wd.ActivePrinter = "\\rtprintsrv\NM092PRT15-182"

wdocSource.Close SaveChanges:=False

Set wdocSource = Nothing
Set wd = Nothing


End Sub

 

[SkipVought]

Hi,

How about...

    wd.Visible = True
    wd.ActivePrinter = "\\rtprintsrv\NM092PRT15-182"[b]
    Application.ActivePrinter = "\\rtprintsrv\NM092PRT15-182"[/b]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}