VBA MailMerge from Excel - Error Message waiting for OLE action - excel

Question

Good Morning
I'm trying to clean up a macro that is behaving erraticly. It used to work - on a good day. But it throws up this error: "Microsoft Excel is waiting for another application to complete an OLE action". I've tried to clean it up (which caused all sorts of other errors, now sorted) and I'm back to being able to step through it but it again stops at above error.
What I have noticed that it used to do one certificate and then throw the error but now the error occurs straight away when it's trying to open the template. This is the line:
Set objMMMD = objWord.Documents.Open(cDir & WTempName)
objMMMD.Activate
My original thought was that the code didn't close Word cleanly but now that the error is so early, that can't be it. I don't have Word open. - Since it used to open Word before my revision, the code should be correct as well.
I can't find much on the error apart from that it seems to occur in more complicate codes due to timeout and how to suppress the message. Neither seems to be of help here.
Below the entire code. Does anybody have any idea why Excel can't open Word to do the mailmerge?
Public Sub MailMergeCert()
Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document
Dim FirstName As String
Dim LastName As String
Dim Training As String
Dim SeminarDate As String
Dim HoursComp As String
Dim Location As String
Dim Objectives As String
Dim Trainer As String
Dim cDir As String
Dim ThisFileName As String
'Your Sheet names need to be correct in here
Dim sh1 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("Ultrasound")
Dim r As Long
r = 2
FirstName = sh1.Cells(r, 1).Value
LastName = sh1.Cells(r, 2).Value
Training = sh1.Cells(r, 3).Value
SeminarDate = Format(sh1.Cells(r, 4).Value, "d mmmm YYYY")
HoursComp = sh1.Cells(r, 5).Value
Location = sh1.Cells(r, 6).Value
Objectives = sh1.Cells(r, 7).Value
Trainer = sh1.Cells(r, 8).Value
'Setup filenames
Const WTempName = "Certificate_Ultrasound_2017.docx" 'Template name
'Data Source Location
cDir = ActiveWorkbook.Path + "\" 'Change if required
ThisFileName = ThisWorkbook.Name
On Error Resume Next
'Create Word instance
bCreatedWordInstance = False
Set objWord = CreateObject("Word.Application")
If objWord Is Nothing Then
Err.Clear
Set objWord = CreateObject("Word.Application")
bCreatedWordInstance = True
End If
If objWord Is Nothing Then
MsgBox "Could not start Word"
Err.Clear
On Error GoTo 0
Exit Sub
End If
' Let Word trap the errors
On Error GoTo 0
' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False
'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir & WTempName)
objMMMD.Activate
'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir & ThisFileName, _
sqlstatement:="SELECT * FROM `Ultrasound$`" ' Set this as required
lastrow = Sheets("Ultrasound").Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastrow
If IsEmpty(Cells(r, 11).Value) = False Then GoTo nextrow
With objMMMD.MailMerge 'With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = r - 1
.LastRecord = r - 1
.ActiveRecord = r - 1
End With
.Execute Pause:=False
End With
'Save new file PDF
Dim UltrasoundCertPath As String
UltrasoundCertPath = "C:\Users\305015724\Documents\ApplicationsTraining\2016\Ultrasound\"
Dim YYMM As String
YYMM = Format(sh1.Cells(r, 16).Value, "YYMM")
Dim NewFileNamePDF As String
NewFileNamePDF = YYMM & "_" & sh1.Cells(r, 3).Value & "_" & sh1.Cells(r, 7).Value '& ".pdf" 'Change File Name as req'd"
objWord.ActiveDocument.ExportAsFixedFormat UltrasoundCertPath & NewFileNamePDF, ExportFormat:=wdExportFormatPDF
nextrow:
Next r
End With
' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing
If bCreatedWordInstance Then
objWord.Quit
End If
Set objWord = Nothing
Cells(r, 11).Value = Date
0:
Set objWord = Nothing
End Sub

Answer 1

Try changing
cDir = ActiveWorkbook.Path + "\"
To
cDir = ActiveWorkbook.Path & "\"
Does that make a difference. Also try printing the cDir if its what expect.
Try message box the cDir to check the path.
MsgBox(cDir, vbOKOnly, "Testing cDir")