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