Hi everybody -
I will preface this question with, I'm very new to this -- in MS Access I have a letter management module that spits out a mail merge template in Word that I then clickfinish and merge.
From that new file, I then click on macros to run the Splitter that then splits my document into individually saved docs. After the files are in the folder I then need to go back and rename them all to a specific naming format is used in the database to lookup the doc.
My question: Can I cut the steps down and build the MS Access / VB macros with the mail merge, document splittter and name it using info stored in a few of the merge fields? So all I need to do is click "go" (so to speak) and it automates as much as possible? My biggest complaint is renaming all the files which are specific to the addressed person in the letter, and thus always change with each letter : Numberstring_Firstinitial.Lastname.doc - I could probably edit it to: Numberstring_Firstname.Lastname.doc .
Any Ideas? My code below.
Thanks!
Elizabeth
Mail merge code:
Public Sub PrintLetter()
Dim objApp As Object
Dim strConnect As String
DoCmd.Hourglass True
DoCmd.SetWarnings False
DoCmd.OpenQuery "RIFLetterData_Q"
DoCmd.OpenQuery "Update to Correct Case"
Set objApp = CreateObject("Word.Application")
strConnect = "DSN=MS Access Databases;DBQ=C:\...\RIFDB_P44.mdb;FIL=MS Access;"
DoCmd.SetWarnings True
DoCmd.Hourglass False
With objApp
.Visible = True
.Documents.Open "C:\...\RIFLetter.doc"
.ActiveDocument.MailMerge.OpenDataSource Name:="C:\...\RIFDB_P44.mdb", Connection:=strConnect, SQLStatement:="SELECT * FROM [RIF Letter Data]", ReadOnly:=True
End With
End Sub
Splitter:
Sub Splitter()
' Based on a Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
Dim Mask As String
Dim Letters As Long
Dim Counter As Long
Dim DocName As String
Dim oDoc As Document
Dim oNewDoc As Document
Set oDoc = ActiveDocument
oDoc.Save
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Mask = "ddMMyy"
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
DocName = "C:\\users\...\ _" & Format(Date, Mask) _
& " " & LTrim$(Str$(Counter)) & ".doc"
oDoc.Sections.First.Range.Cut
Set oNewDoc = Documents.Add
'Documents are based on the Normal template
'To use an alternative template follow the link.
With Selection
.Paste
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
oNewDoc.SaveAs FileName:=DocName, _
FileFormat:=wdFormatDocument, _
AddToRecentFiles:=False
ActiveWindow.Close
Counter = Counter + 1
Wend
oDoc.Close wdDoNotSaveChanges
End Sub