Here is the code as it is now. The merge document is displayed and the user can then finish the merge.
Option Compare Database
Public lngMyEmpID As Long
Public datDate1 As Date
Public datDate2 As Date
Public datDate3 As Date
Sub OpenWordDoc(strDocName As String, strLetterDescription As String, strFormName As String)
On Error Resume Next
DoCmd.OpenQuery "qrydeleteMergeTablerows"
'Load data to MergeTable with a query that collects the required data after update
If strFormName = "Volunteers" Then
If strLetterDescription = "REFERENCE REQUEST" Then
DoCmd.OpenQuery ("qryUpdateRefereeLetterDate")
DoCmd.OpenQuery ("qryReferees")
Else
If strLetterDescription = "Referee chaser" Then
DoCmd.OpenQuery ("qryUpdateRefereeChaserDate")
DoCmd.OpenQuery ("qryRefereechaser")
Else
DoCmd.OpenQuery ("qryVolunteer")
End If
End If
Else
DoCmd.OpenQuery ("qryClient")
End If
Dim objApp As Object
Dim strCurrentFileName As String
strCurrentFileName = CurrentDb.Name
'Opens the document
Set objApp = CreateObject("Word.Application")
objApp.Visible = False
'Dim objMMMD As Object
'Set objMMMD = objApp.Documents.Open(FileName:=strDocName)
' objApp.ChangeFileOpenDirectory "C:\Temp\"
objApp.Documents.Open FileName:=strDocName, ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False _
, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", XMLTransform:=""
'Format:=wdOpenFormatAuto
' "C:\Documents and Settings\mike\My Documents\Mind\MIB.mdb", _
'Data Source=C:\Documents and Settings\mike\My Documents\Mind\MIB.mdb
objApp.ActiveDocument.MailMerge.OpenDataSource Name:= _
strCurrentFileName, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";Us er ID=Admin;Date Source=strCurrentFileName;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB
atabase Password="""";Jet OLE" _
, SQLStatement:="SELECT * FROM `mergetable`", SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
With objApp.ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
End With
.Execute Pause:=False
End With
Dim intSplitName As Integer
Dim intLength As Integer
intLength = Len(strDocName)
intSplitName = InStrRev(strDocName, "\", , vbTextCompare)
strDocName = Right(strDocName, intLength - intSplitName)
objApp.Windows(strDocName).Activate
objApp.ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
'objMMMD.Close SaveChanges:=False
'Set objMMMD = Nothing
'objApp.Documents.Open strDocName
objApp.Visible = True
objApp.Activate
End Sub
I really do appreciate the help you give!
Murray