[Murray Muspratt-Rouse]

Originally Posted by Murray Muspratt-Rouse

I do not speak VBA! I have managed to stop Word from displaying Save As but have finished up with the Word document displayed, but not the result of the merge. I have tried inserting the code for "MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)" but that fails. What I would like is to have the merge result alone displayed.

I attach the VBA module exported as .bas in a zip file since copying it as text into Word came out too large.

Many thanks in advance for your help

Murray

To explain: - I have recently been asked by a UK charity to help update their system. I have 'inherited' what has been constructed for them in Access, with use of Word Mail Merge, controlled by a Visyal Basic module. I was asked to upgrade to MS Office 2007. As I got it the mail merge process ended with a Save As display, the original document and the resuilt of the merge. What I want to achieve is the display of the merge result alone. By adding SaveChanges:=wdDoNotSaveChanges I have got rid of the Save As display, but now only the original document appears, which allows preview of the result of the merge. I did not include the VBA code in my original post, because I thought that would break the rules. I append it below.

Murray


Option Compare Database
Public lngMyEmpID As Long
Public datDate1 As Date
Public datDate2 As Date
Public datDate3 As Date



Sub OpenWordDoc(strDocName As String, strFormName As String)
On Error Resume Next
DoCmd.OpenQuery "qrydeleteMergeTablerows"

'Load data to MergeTable with one of two queries

If strFormName = "Volunteers" Then
DoCmd.OpenQuery ("qryVolunteer")
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

' 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 OLEDBatabase 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




'objApp.Documents.Open strDocName


objApp.Visible = True

End Sub



'[Forms]![Volunteers]![VolunteerID]



Public Function CheckMerge() As Integer
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
CheckMerge = MsgBox(" Please Confirm", vbYesNo, "Merge Letter")
End Function


Public Sub OpenLetters(strLetterName As String)

Dim stDocName As String
Dim stLinkCriteria As String
Dim stArgs As String

stDocName = "Letters"
stArgs = strLetterName

DoCmd.OpenForm stDocName, , , stLinkCriteria, acFormPropertySettings, acWindowNormal, stArgs


End Sub

Public Function GetNow() As Date
GetNow = FormatDateTime(Now, vbShortDate)
End Function

Public Sub ShowMatchDetails()
Forms!volunteers.cmbFindsurname.SetFocus
With Forms!volunteers![sbfBefriendingMatchVolunteer].Form
.Visible = (.RecordsetClone.RecordCount 0)
End With
If Forms!volunteers![sbfBefriendingMatchVolunteer].Form.Visible = False Then
Forms!volunteers.InsideHeight = 5300
Forms!volunteers.cmdMatchClient.Visible = True
Else
Forms!volunteers.InsideHeight = 8200
Forms!volunteers.cmdMatchClient.Visible = False

End If

End Sub