Sub Test()
    Dim objWord As Object, oDoc As Object
    Dim StrSQL As String, fName As String, StrSrc As String
    Const wdSendtToNewDocument = 0
    Const wdDirectory = 3
    Const wdMergeSubTypeAccess = 1
    Const wdOpenFormatAuto = 0
    StrSQL = "SELECT * FROM [CORE$]"
    'StrSQL = "SELECT * FROM [CORE$] " & _
              "ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC"
    'StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]=DR " & _
              "ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC"
    'StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]=""""DR"""" " & _
              "ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC"
    'StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]=[" & itype & "] AND [SIG_CREW]= [" & isubresp & "]" & _
              "ORDER BY [START] ASC, [COMPLEX] ASC, [UNIT] ASC"
    StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\Aug-30 (Sun) schedule_3.xlsx"
    fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\DR15v1.docx"
      
    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 = wdDirectory
                .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
    End With
End Sub