Paul, with your second recommendation, the correct merge document became visible and Word didn't hang. It did however prompt me to select a table. The field to select a table was blank.
The workbook to what it was referring to was weird. It is a workbook I didn't create, Excel created it on it's own putting it in the directory on my main Excel document. It was with an '.xls' extension and can't be opened.
In due time, the 'Waiting for OLE' message appears followed by a "Command failed" error with the line in red.
Code:
Sub Merge2(ByVal i As Long, ByVal ws_vh As Object)
Dim ws_th As Worksheet
Set ws_th = Workbooks("Sports15b.xlsm").Worksheets("TEMP_HOLD")
itype = Right(ws_th.Range("A" & i + 1), 2)
isubresp = Left(ws_th.Range("A" & i + 1), 3)
If itype = "DR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\DR15v1.docx"
ElseIf itype = "DT" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\DT15v1.docx"
ElseIf itype = "FR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\FR15v1.docx"
ElseIf itype = "FT" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\FT15v1.docx"
ElseIf itype = "CR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\CR15v1.docx"
Else
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\CT15v1.docx"
End If
Set objWord = CreateObject("Word.Application")
With objWord
.DisplayAlerts = False
.Visible = True
Set oDoc = objWord.Documents.Open(Filename:=fName, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=True)
StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
MsgBox StrSrc
With oDoc
MsgBox "Type: " & itype & Chr(13) & "Sig_Crew: " & isubresp
With .MailMerge
.MainDocumentType = wdDirectory
.Destination = wdSendtToNewDocument
.SuppressBlankLines = True
.OpenDataSource _
Name:=StrSrc, ReadOnly:=True, AddToRecentFiles:=False, LinkToSource:=False, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `CORE$` WHERE [TYPE]='" & itype & "' AND [SIG_CREW]= '" & isubresp & "' ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC", _
SQLStatement1:="", SubType:=wdMergeSubTypeAccess
.Execute Pause:=False
End With
.Close False
End With
.DisplayAlerts = True
End With
End Sub