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:=True, _
            ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
        StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
        MsgBox StrSrc
        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:="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