A datasource described as:
H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1.xls
suggests all there was in ws_vh.Range("B4") was ".xls"
That said, I can't see how the path separator (\) after DATA1 could get deleted.
Try:
Code:
Sub Merge2(ByVal i As Long, ByVal ws_vh As Object)
Dim objWord As Object, oDoc As Object, oDoc2 As Object
Dim myPath As String, fName As String, StrSrc As String
Dim itype As String, isubresp As String, StrSQL As String
Dim ws_th As Worksheet
Const wdSendtToNewDocument = 0
Const wdSendToPrinter = 1
Const wdFormLetters = 0
Const wdDirectory = 3
Const wdNotAMergeDocument = -1
Const wdMergeSubTypeAccess = 1
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)
StrSQL = "SELECT * FROM `CORE$` WHERE [TYPE]='" & itype & "' AND [SIG_CREW]= '" & isubresp & "' ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC"
StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
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
MsgBox "Mailmerge Main Document: " & fName
MsgBox "Data Source: " & StrSrc & vbCr & "Type: " & itype & vbCr & "Sig_Crew: " & isubresp & vbCr & "SQL: " & StrSQL
Set objWord = CreateObject("Word.Application")
With objWord
.DisplayAlerts = False
.Visible = True
Set oDoc = .Documents.Open(Filename:=fName, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=True)
With oDoc
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:=StrSQL, SQLStatement1:="", SubType:=wdMergeSubTypeAccess
.Execute Pause:=False
End With
.Close False
End With
.DisplayAlerts = True
End With
End Sub