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, AddToRecentFiles:=False, LinkToSource:=False, ConfirmConversions:=False, _
                    ReadOnly:=True, Format:=wdOpenFormatAuto, 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

.OpenDataSource Name:=StrSrc, AddToRecentFiles:=False, LinkToSource:=False, ConfirmConversions:=False, _
                    ReadOnly:=True, Format:=wdOpenFormatAuto, 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