Sub merge2(ByVal i As Long, ByVal rpt_od As String, objWord As Object, ByVal dest As Long)

    Dim oDoc As Object, oDoc2 As Object
    Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String, myPath As String
    Dim qfile As String, st_srchfn As String, wb_qfile2 As Workbook, itype As String, isubresp As String
    'Dim wb_qfile2 As Workbook
    Dim HdFt As Variant
    
    Const wdSendtToNewDocument = 0
    Const wdSendToPrinter = 1
    Const wdFormLetters = 0
    Const wdDirectory = 3
    Const wdMergeSubTypeAccess = 1
    Const wdOpenFormatAuto = 0
    
    work_fn = ws_vh.Range("N2")
    Set wb_nwb = Workbooks(work_fn)
    
    'create workorders folder
    myPath = "u:\PWS\Parks\Parks Operations\Sports\Sports17\WORKORDERS\" & format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
    If Dir(myPath, vbDirectory) = "" Then 'if not already created ...
        MkDir myPath
    End If
    
    'close data file
    st_srchfn = "u:\PWS\Parks\Parks Operations\Sports\Sports17\DATA\" & ws_vh.Range("N2")
    If wb_nwb Is Nothing Then
        MsgBox wb_nwb & " is NOT open."
    Else
        wb_nwb.Close True 'saves data workbook after TYPE was updated for GS
    End If
  
    itype = Right(ws_th.Range("A" & i), 2)
    isubresp = Left(ws_th.Range("A" & i), 3)
    
    If itype = "DR" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\DR15v1.docx"
    ElseIf itype = "DT" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\DT15v1.docx"
    ElseIf itype = "FR" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\FR15v1.docx"
    ElseIf itype = "FT" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\FT15v1.docx"
    ElseIf itype = "CR" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\CR15v1.docx"
    ElseIf itype = "CT" Then
        fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\CT15v1.docx"
    ElseIf itype = "GS" Then
        If isubresp = "HPE" Or isubresp = "HPL" Then
            fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\GS15v1_GSH.docx" 'Passive : Hillside
        Else
            fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\GS15v1_GS.docx" 'Passive : Wloo Park
        End If
    Else
        fName = "U:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\GS15v1_GM.docx"
    End If
    
    StrSrc = "u:\PWS\Parks\Parks Operations\Sports\Sports17\DATA\" & ws_vh.Range("N2")
 
    StrSQL = "SELECT * FROM [DATA$] 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
        
        'page break routine only for sports reports
        If (Left(itype, 1) <> "G") And (itype <> "DT") Then   'exclude GS reports
            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 If
    
    End With
    
    Set oDoc2 = objWord.activedocument

    'save newly created document
    With oDoc2
        myPath = "u:\PWS\Parks\Parks Operations\Sports\Sports17\WORKORDERS\" & format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
        .SaveAs myPath & "\" & rpt_od & ".docx"
        If dest = 2 Then
            .PrintOut
        End If
        '.Close
    End With
        

    Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing

End Sub