Dim objWord As Object, oDoc As Object, oDoc2 As Object
Dim myPath As String, fName As String, StrSrc As String
Dim itype As String
Dim isubresp As String

Const wdSendtToNewDocument = 0
Const wdSendToPrinter = 1
Const wdFormLetters = 0
Const wdDirectory = 3
Const wdNotAMergeDocument = -1
Const wdMergeSubTypeAccess = 1   


Set oDoc = objWord.Documents.Open(Filename:=fName, ConfirmConversions:=True, _
        ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
    'StrSrc = ThisWorkbook.FullName
    StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
    MsgBox StrSrc
    With oDoc
        With .MailMerge
            .MainDocumentType = wdDirectory
            .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
                .Destination = wdSendtToNewDocument
            .SuppressBlankLines = True
            With .DataSource
              .FirstRecord = 1
              .LastRecord = .RecordCount
            End With
            .Execute Pause:=False
            .MainDocumentType = wdNotAMergeDocument
        End With
        .Close False
        
    End With