mail merge Access into Word .dot as new .doc

maryenc

New member
Local time
Today, 09:37
Joined
Nov 3, 2005
Messages
6
Hello,

Currently, I am mail merging data from Access into a Word .doc via a macro line:
RunApp -> Command Line = "Winword.exe "i:\GIA\MergeLetter.doc""
This works fine for the merging, however, my user somehow unknowingly (evidently) changed the base MergeLetter.doc so that it no longer had the merge fields.

I've corrected the .doc, but to prevent this problem in the future, I'd like the make the .doc into a .dot (template) and have Access "click" the template and create a new .doc (just as you would be doing if you clicked a templete from Word yourself). The problem I'm running into is, when I change the Command Line to "Winword.exe "i:\GIA\MergeLetter.dot"", it opens the actual template (as you might expect), but I can't figure out a way to make it create the new .doc from the RunApp via Access. I tried creating a shortcut file, naming it .lnk, and RunApp on that, but that doesn't work either.

Any ideas?

Thanks--Mary E.
 
Hi, as no-one has responded I will give you the following - it is entirely "as is" and I will struggle to respond with much help (I will try when I can). However, most of what you are after is in the MakeLetter() function - i.e. you will need to declare and manipulate a Word.Document type object. Once you have that you can actually perform most of the menu types calls in Word, after creating a Word.Document type object and see what methods and functions you have available. if you have difficulty please ask, but it may take a while. the other functions are primarily to support MakeLetter() and you may not need them. you may also have to add a "Microsoft Word xx.0 Object Library" reference under Tools then References in Microsoft Visual Basic (via Alt F11). the code below leaves Word maximised and ready for the user to edit the document, your template name should be in "strFileName" and your output filename should be stored in "strLetterName". i would recommend putting the whole lot in a separate module:

Public objWord As Word.Application
Public WordDoc As Word.Application

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As Any, ByVal lpWindowname As Any) As Long

Type adh_accOfficeGetFileNameInfo
hwndOwner As Long
strAppName As String * 255
strDlgTitle As String * 255
strOpenTitle As String * 255
strFile As String * 4096
strInitialDir As String * 255
strFilter As String * 255
lngFilterIndex As Long
lngView As Long
lngFlags As Long
End Type

' GetFileNameInfo flags
Public Const adhcGfniConfirmReplace = &H1 ' Prompt if overwriting a file?
Public Const adhcGfniNoChangeDir = &H2 ' Disable the read-only option
Public Const adhcGfniAllowReadOnly = &H4 ' Don't change to the directory the user selected?
Public Const adhcGfniAllowMultiSelect = &H8 ' Allow multiple-selection?
Public Const adhcGfniDirectoryOnly = &H20 ' Open as directory picker?
Public Const adhcGfniInitializeView = &H40 ' Initialize the view to the lView member or use last selected view?

Public Const adhcAccErrSuccess = 0

Declare Function adh_accOfficeGetFileName Lib "msaccess.exe" _
Alias "#56" (gfni As adh_accOfficeGetFileNameInfo, ByVal fOpen As Integer) As Long


Public Function MakeLetter(strLetterName As String, Optional strTemplateName As String, Optional strQueryName As String, Optional strDocumentName As String, Optional strParatext As String) As Boolean
On Error GoTo Err_MakeLetter

Dim rst As Recordset
Dim dbs As Database
Dim tdf As TableDef
Dim fld As Field
Dim varContents As Variant
Dim sngTemp As Single
Dim objWord As Word.Application
Dim objWordDoc As Word.Document
Dim ok As Boolean
Dim strFileName As String
Dim strSQL As String
Dim strMess As String

If Len(Trim(strTemplateName)) < 3 Then
strFileName = getFileName("Select Standard Template Required", strTemplatesPath & "Templates", "TEMPLATE FILES(*.doc; *.dot)")
Else
strFileName = strTemplateName
End If

If Len(Trim(strFileName)) > 0 Then

If FindWindow("OpusApp", vbNullString) = 0 Then
Set objWord = CreateObject("Word.Application.8")
Else
Set objWord = GetObject(, "Word.Application.8")
End If

objWord.Visible = True
objWord.WindowState = wdWindowStateMaximize

Set objWordDoc = objWord.Documents.Add(strFileName)

If Len(Trim(strDocumentName)) > 3 Then
objWordDoc.Bookmarks("DocumentName").Select
objWordDoc.Application.Selection.TypeText Text:=strDocumentName

If objWordDoc.ActiveWindow.View.SplitSpecial = wdPaneNone Then
objWordDoc.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
objWordDoc.ActiveWindow.View.Type = wdPrintView
End If
objWordDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If objWordDoc.ActiveWindow.View.SplitSpecial = wdPaneNone Then
objWordDoc.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
objWordDoc.ActiveWindow.View.Type = wdPrintView
End If
End If

objWordDoc.SaveAs FileName:=strLetterName
objWord.WindowState = wdWindowStateMaximize

Set objWord = Nothing

MakeLetter = True
Else
strMess = "No selection made!"
MsgBox strMess, vbOKOnly + vbExclamation, "Oops"
End If

Exit_MakeLetter:
DoCmd.SetWarnings True
Exit Function

Err_MakeLetter:
MsgBox Err.Description
Resume Exit_MakeLetter
End Function

Function getFileName(strWindowTitle As String, strInitialDir As String, strFileTypes As String)
Dim gfni As adh_accOfficeGetFileNameInfo
Dim lngFlags As Long
Dim strFileName As String

' On Error GoTo HandleErrors
lngFlags = lngFlags Or adhcGfniConfirmReplace Or adhcGfniNoChangeDir Or adhcGfniInitializeView
With gfni
.lngView = 1
.lngFlags = lngFlags
.strFilter = strFileTypes
.lngFilterIndex = 1
.strFile = ""
.strDlgTitle = strWindowTitle
.strOpenTitle = "Select"
.strFile = ""
.strInitialDir = strInitialDir
End With

If adhOfficeGetFileName(gfni, -1) = adhcAccErrSuccess Then
strFileName = Trim(gfni.strFile)
If strFileName <> "" Then
getFileName = strFileName
Else
MsgBox "You have not chosen a file", vbOKOnly
End If
End If
End Function

Function adhOfficeGetFileName(gfni As adh_accOfficeGetFileNameInfo, _
ByVal fOpen As Integer) As Long


Dim lng As Long
With gfni
.strAppName = RTrim$(.strAppName) & vbNullChar
.strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
.strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
.strFile = RTrim$(.strFile) & vbNullChar
.strInitialDir = RTrim$(.strInitialDir) & vbNullChar
.strFilter = RTrim$(.strFilter) & vbNullChar
SysCmd acSysCmdClearHelpTopic
lng = adh_accOfficeGetFileName(gfni, fOpen)
.strAppName = RTrim$(adhTrimNull(.strAppName))
.strDlgTitle = RTrim$(adhTrimNull(.strDlgTitle))
.strOpenTitle = RTrim$(adhTrimNull(.strOpenTitle))
.strFile = RTrim$(adhTrimNull(.strFile))
.strInitialDir = RTrim$(adhTrimNull(.strInitialDir))
.strFilter = RTrim$(adhTrimNull(.strFilter))
End With
adhOfficeGetFileName = lng
End Function
 
Wow! :eek: To make it open a new .doc from a .dot would take all of that & than some?!? Well, I'm not much of a programmer so, if it's that complicated, I'll just have to save an extra copy of the .doc the user is currently opening in case she hoses it again. Going from 1 line in a macro to open a mergeable .doc to all of that & still not having it completed is a lot more time than I have to put into this project, especially since I'm *extremely* weak in the programming dept.

Many thanks for all your time & effort in this post, though!
 

Users who are viewing this thread

Back
Top Bottom