Sub merge2(ByVal i As Long, ByVal ws_vh As Object, ByVal rpt_od As String, objWord As Object, ByVal dest As Double)
 '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
 'Dim wb_qfile2 As Workbook
 
 Const wdSendtToNewDocument = 0
 Const wdSendToPrinter = 1
 Const wdFormLetters = 0
 Const wdDirectory = 3
 Const wdMergeSubTypeAccess = 1
 Const wdOpenFormatAuto = 0
 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
             If dest = 1 Then
                 .Destination = wdSendtToNewDocument
             Else 'dest=2
                 .Destination = wdSendToPrinter
             End If
                .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
    'MsgBox oDoc2.Name
    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"
        '.Close
    End With
 
    AppActivate "Microsoft Excel"
    Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing
    'End If
    Workbooks.Open st_srchfn
End Sub