Mail Merge from Access - Word throws "Cannot Open Data Source" Error

  • Thread starter Thread starter Eric
  • Start date Start date
E

Eric

I am getting a pop-up error after I open the merge document, (even
though the merge works), that states that word cannot open the data
source. (even though it does)
Has anyone encountered this and what was the fix?

Thank you in advance!

Here is the code.

+++++++++++++++

Private Sub Command416_Click()
On Error GoTo err_proc

Dim strMessage As String
Dim strSQL As String
Dim wdApp As Object
Dim wdDoc As Object
Dim myMerge As Object
Dim strMrgSrce As String
Dim strPath As String
Dim strDocName As String
Dim strSavfile As String
Dim strDocPath As String
Dim strCriteria As String
strCriteria = Me![JobSearch]

strMrgSrce = "MergeDataSource.mdb"
strPath = CurrentProject.Path & "\" & strMrgSrce
strDocPath = CurrentProject.Path & "\"
strDocName = strDocPath & "TCP.doc"

CurrentDb.Execute "Delete * FROM [" & strPath & "].tempTable",
dbFailOnError

strSQL = "INSERT INTO [" & strPath & "].tempTable ( Fields ) " & _
"SELECT * FROM dbo_BB_vw_MergeDocuments WHERE JobDescription ='" &
strCriteria & "';"


CurrentDb.Execute strSQL, dbFailOnError


Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(strDocName)
Set myMerge = wdDoc.MailMerge

With myMerge
.OpenDataSource Name:=strPath, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=0, _
Connection:="Provider=Microsoft.Jet.OLEDB.
4.0;Password="""";User ID="""";Data Source=" & strMrgSrce &
";Mode=Read;Extended Properties="""";Jet OLEDB:System
database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database
Password="""";Jet OLEDB:Engine Type=4;Jet OLEDB:Data", _

SQLStatement:="SELECT * FROM 'tempTable' ", _
SQLStatement1:="", _
OpenExclusive:=False, _
subtype:=wdMergeSubTypeWord2000
.MainDocumentType = 0
.Destination = 0 'SendToNewDocument
.SuppressBlankLines = True
.Execute
End With


wdApp.ActiveDocument.SaveAs FileName:=strSavfile, FileFormat:=0,
_
LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

wdDoc.MailMerge.MainDocumentType = -1 'wdNotAMergeDocument
wdDoc.Save
wdDoc.Close 0

exit_proc:

On Error Resume Next
Set wdDoc = Nothing
Exit Sub

err_proc:

MsgBox Err.Description & Chr(13) & strSavfile
Resume exit_proc

End Sub
 
Solved it...

Changed ....

err_proc:
MsgBox Err.Description & Chr(13) & strSavfile
Resume exit_proc
End Sub


to this

err_proc:
Resume exit_proc
End Sub

...Duh..
 
No offense, but you did NOT solve the problem. All you did was eliminate the
error message: whatever's causing the error is still there (and could come
back to cause problems if you don't resolve it)

See whether changing

strSQL = "INSERT INTO [" & strPath & "].tempTable ( Fields ) " & _
"SELECT * FROM dbo_BB_vw_MergeDocuments WHERE JobDescription ='" &
strCriteria & "';"

to

strSQL = "INSERT INTO [;Database=" & strPath & "].tempTable ( Fields ) "
& _
"SELECT * FROM dbo_BB_vw_MergeDocuments WHERE JobDescription ='" &
strCriteria & "';"

makes any difference.

If not, single-step through the code to determine which line of code causes
the error.

At the very least, takes Adrian's advice!
 
Back
Top