Mail Merge Info into a Word Doc from Access

[Prog76]

I am trying to merge certain fields from a table in Access to a Word doc, but I am recieving an error: "Word cannot open the data source". Here is the code that it is bombing on.

ObjWord.mailmerge.OpenDataSource _
Name:=lvQISName, _
LinkToSource:=True, _
Connection:="TABLE tblBPAMerge", _
SQLStatement:="Select * from [tblBPAMerge] WHERE Initials='" _
& [Forms]![frmMainMenu]![txtInitials] & "'"

When I put a stop in the code, the dialog boxes pop up and one gives a choice of Datasources. It seems that when it chooses the datasource as OLE DB it bombs, but if MS Access databases via DDE is chosen it works fine?? Help. The user will not see these dialog boxes and will not have the choic.

 

[PaulBricker]

I don't really see anything, I have the same type of code in one of my apps and it runs fine. The only difference is the Connection:="QUERY etc.

You might try creating a query from your table and use that in the Connection line. If may be that Access uses an OLE DB as default with a table and may use DDE with a query. Just a guess.

Paul

 

[Prog76]

The query didn't work. Hmm. I don't know what to do. Thank you.

 

[PaulBricker]

Can you post all the code. At least I can compare the whole thing with mine.

Paul

 

[Prog76]

Here is the code sorry it is so lengthy.

Private Sub MergeIt()
On Error GoTo Err_MergeIt

Dim ObjWord As Object
Dim lvPath As Variant
Dim lvQISName As Variant
Dim letterDoc As String
Dim WordObj As Object
Dim MyRange
Dim myFile
Dim lnResponse As String
Dim dbCurrent As Database

Set dbCurrent = CurrentDb

lsFilename = letterDoc & "BPA_" & [Forms]![frmBPA]![cboSelectCustomer] & "_" _
& [Forms]![frmMainMenu]![txtInitials] & "_" & Format(Date, "yyyymmdd&quot & ".doc"
myFile = Dir(lsFilename)
If myFile = "" Then ' Didn't find the file
Else ' File found, ask if ok to overwrite
lnResponse = MsgBox("Is it OK to overwrite your last copy of this file?", vbYesNo, "QIS BPA&quot
If lnResponse = vbNo Then
GoTo Exit_MergeIt
End If
End If

' Find the path and name of QIS
lvPath = DLookup("QISLocation", "tblLocationNumbers", "DefaultLocation = True&quot
'lvQISName = DLookup("QISApplicationName", "tblLocationNumbers", "DefaultLocation = True&quot
lvQISName = dbCurrent.Name
lsFilename = lvPath & "Bpa\BPAAllSectII.doc"
letterDoc = "G:\QIS\BPADocs\"

' Open the Word document
Set ObjWord = CreateObject("word.basic&quot

Set ObjWord = GetObject(lsFilename, "Word.Document&quot ' Make Word visible which opens Access for merge
ObjWord.Application.Visible = True ' Set the mail merge data source as the qis database & opens Word
ObjWord.mailmerge.OpenDataSource _
Name:=lvQISName, _
LinkToSource:=True, _
Connection:="TABLE tblBPAMerge", _
SQLStatement:="Select * from [tblBPAMerge] WHERE Initials='" _
& [Forms]![frmMainMenu]![txtInitials] & "'"
ObjWord.mailmerge.Execute 'creates Word document

'Save the files as BPA_[CUSTNAME]_xxx_YYYYMMDD.DOC, where xxx are initials of person logged on
lsFilename = letterDoc & "BPA_" & "_" _
& [Forms]![frmMainMenu]![txtInitials] & "_" & Format(Date, "yyyymmdd&quot & ".doc"

ObjWord.Application.ActiveDocument.SaveAs Filename:=lsFilename, FileFormat:=0

Set MyRange = ObjWord.Application.Documents(lsFilename).Content

'
' For each radio button, see if it was selected, if not, delete the associated
' Word table
'
If optEmptyDrum = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Empty Drum Recycling and Disposal Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optLabPack = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Lab Packing Service"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optWarehousing = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Public Chemical Warehousing"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete

End If

If optERS = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Emergency Response Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optERSFF = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Emergency Response Services (Fixed Facility)"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optProductSales = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Product Sales"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optTrngSvcs = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Training Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optTransWstDisp = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Transportation and Waste Disposal Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optTransportation = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Transportation Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

If optRemSvcs = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Remediation Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If


If optCCS = False Then
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Comprehensive Chemical Services"
End With
MyRange.Find.Execute
MyRange.Tables(1).Select
MyRange.Tables(1).Rows.Delete
MyRange.Words(1).Delete
End If

'If Pricing is selected...
With MyRange.Find
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="(Pricing)"
End With
MyRange.Find.Execute

' NOTE: If you want to print the merged document, delete the Execute statement above
' and add the following four lines of code above the End Function statement:
' objWord.MailMerge.Destination = wdSendToNewDocument objWord.MailMerge.Execute
' 'The following line must follow the Execute statement because the 'PrintBackground
' property is available only when a document window is 'active. Without this line of code,
' the function will end before Word 'can print the merged document.
' objWord.Application.Options.PrintBackground = False
' objWord.Application.ActiveDocument.PrintOut

' Save the file again after all the tables have been deleted
ObjWord.Application.ActiveDocument.SaveAs Filename:=lsFilename, FileFormat:=0

DoCmd.OpenQuery "qryBPADeleteCustomerInfo"
MsgBox "Please close MS Word when you are finished editing this document."

Exit_MergeIt:
Exit Sub

Err_MergeIt:
MsgBox Err & " " & Err.Description

Resume Exit_MergeIt


End Sub

 

[PaulBricker]

I should have said that my code does not use a Where clause but I was able to reproduce your problem and the only way I have found around it is to use a query and put the criteria in the query
=Forms!frmMainMenu!txtInitials
instead of in the code.

Then just use the lines

Name:=lvQISName, _
LinkToSource:=True, _
Connection:="QUERY qryName", _
SQLStatement:="Select * from qryName"
ObjWord.mailmerge.Execute 'creates Word document

That seems to eliminate the "Can't open source data" error.

Paul

 

[Prog76]

well it is getting better; now it runs, but it still pops up the box to choose a data source?? Did it do that for you?

Thank you so much.

 

[PaulBricker]

No, I've never seen the pop up box. You also have two lines together where you set the value for objWord. I've never seen the object ("Word.Basic&quot
You might try commenting out this line and see if it helps.

Paul