View Single Post
 
Old 04-02-2016, 03:03 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Jenn,

It occurs to me the SQL statement is flawed. In a couple of place, you have ' whereas the SQL requires `, which can be replaced with square brackets. Similarly, the syntax for the .OpenDataSource code is flawed, especially at 'Data Source=StrSrc'. Try:
Code:
Sub Merge2(ByVal i As Long, ByVal ws_vh As Object)
    Dim objWord As Object, oDoc As Object, oDoc2 As Object
    Dim myPath As String, fName As String, StrSrc As String
    Dim itype As String, isubresp As String, StrSQL As String
    Dim ws_th As Worksheet
    Const wdSendtToNewDocument = 0
    Const wdSendToPrinter = 1
    Const wdFormLetters = 0
    Const wdDirectory = 3
    Const wdNotAMergeDocument = -1
    Const wdMergeSubTypeAccess = 1
    Set ws_th = Workbooks("Sports15b.xlsm").Worksheets("TEMP_HOLD")
    itype = Right(ws_th.Range("A" & i + 1), 2)
    isubresp = Left(ws_th.Range("A" & i + 1), 3)
    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\" & ws_vh.Range("B4")
    
    If itype = "DR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\DR15v1.docx"
    ElseIf itype = "DT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\DT15v1.docx"
    ElseIf itype = "FR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\FR15v1.docx"
    ElseIf itype = "FT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\FT15v1.docx"
    ElseIf itype = "CR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\CR15v1.docx"
    Else
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\CT15v1.docx"
    End If
    
    MsgBox "Mailmerge Main Document: " & fName
    MsgBox "Data Source: " & StrSrc & vbCr & "Type: " & itype & vbCr & "Sig_Crew: " & isubresp & vbCr & "SQL: " & StrSQL
      
    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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote