Error - Active x component can't create an object

[siddo]

I'm getting an error - Active X component can't create an object for the below code. Previously the code use to work fine.

Sub SOCMacro()

a = Range("B1").Value
b = Range("B2").Value
C = Range("B3").Value

Application.DisplayAlerts = False
Application.ScreenUpdating = False

d = a & "\" & b
e = a & "\" & C

Call MergeRun("d", "e", "Select [DateA], [Address], [Service Organization Name], [Title of description of service organization’s system],[As of Date(D)],[Date to Date(E)], [Date(H)], [Subservice Orgenaization Name], [Indicate service(s) provided by the subservice organization], [Type or name of system], [Insert the title of subservice organization assertion] FROM [RawData$A2:L5]")

End Sub

Sub MergeRun(frmFile As String, datfile As String, SQL As String)


Dim wdApp As Word.Application
Dim myDoc As Word.Document


Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If


With wdApp

.Visible = True


Set myDoc = .Documents.Open(frmFile, False, False, False)
.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
.ActiveDocument.MailMerge.OpenDataSource Name:=datfile, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:="", SQLStatement:=SQL, SQLstatement1:="", _
SubType:=wdMergeSubTypeOther

With wdApp.ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True


With .DataSource
.FirstRecord = 1
.LastRecord = 2
End With
.Execute Pause:=False
End With

wdApp.Application.DisplayAlerts = wdAlertsAll
End With

errorExit:
On Error Resume Next
myDoc.Close False

 
End Sub

I'm getting an error at this line

Set wdApp = GetObject(, "Word.Application")

 

[Anthony47]

Your current code works id Word is already open; to deal with the "word unopen" condition, enclose the failing instruction betweeen On Error resume Next /GoTo 0:

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0

Bye