Sub merge2(ByVal i As Long, ByVal ws_vh As Object, ByVal rpt_od As String, objWord As Object)
    'Dim objWord As Object, oDoc As Object
    Dim oDoc As Object
    Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String
    Dim ws_th As Worksheet
    Dim qfile As String, st_srchnfn As String, wb_qfile2 As Workbook
    
    
    Const wdSendtToNewDocument = 0
    Const wdSendToPrinter = 1
    Const wdFormLetters = 0
    Const wdDirectory = 3
    Const wdMergeSubTypeAccess = 1
    Const wdOpenFormatAuto = 0
 
    'Const itype As String = "DR"
    'Const isubresp As String = "WPL"
    
    qfile2 = ws_vh.Range("B4")
    
    st_srchfn = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & qfile2
    Set wb_qfile2 = Workbooks(qfile2)
    If wb_qfile2 Is Nothing Then
        MsgBox qfile2 & " is NOT open."
    Else
        'MsgBox qfile2 & " is open"
        wb_qfile2.Close False
        
    End If
    
    
    
    Set ws_th = Workbooks("Sports15b.xlsm").Worksheets("TEMP_HOLD")
    
    itype = Right(ws_th.Range("A" & i), 2)
    isubresp = Left(ws_th.Range("A" & i), 3)
    
    If itype = "DR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DR15v1.docx"
    ElseIf itype = "DT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DT15v1.docx"
    ElseIf itype = "FR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FR15v1.docx"
    ElseIf itype = "FT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FT15v1.docx"
    ElseIf itype = "CR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CR15v1.docx"
    Else
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CT15v1.docx"
    End If
    
    StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
 
    StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]='" & itype & "' AND [SIG_CREW]='" & isubresp & "' " & _
        "ORDER BY [STARTS] ASC, [COMPLEX] ASC, [UNIT] ASC"
 
    '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 = wdFormLetters
                .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
        
        With .ActiveDocument
            If .Sections.Count > 1 Then
                For Each HdFt In .Sections(.Sections.Count).Headers
                    If HdFt.Exists Then
                        HdFt.Range.FormattedText = .Sections(1).Headers(HdFt.Index).Range.FormattedText
                        HdFt.Range.Characters.Last.Delete
                    End If
                Next
                For Each HdFt In .Sections(.Sections.Count).Footers
                    If HdFt.Exists Then
                        HdFt.Range.FormattedText = .Sections(1).Footers(HdFt.Index).Range.FormattedText
                        HdFt.Range.Characters.Last.Delete
                    End If
                Next
            End If
            Do While .Sections.Count > 1
                .Sections(1).Range.Characters.Last.Delete
                DoEvents
            Loop
            .Range.Characters.Last.Delete
        End With
    End With

    Set oDoc2 = objWord.ActiveDocument
    With oDoc2
        myPath = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
        .SaveAs myPath & "\" & rpt_od & ".docx"
    End With
        
    AppActivate "Microsoft Excel"
    Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing
    'End If
End Sub