Merge to Word - 1 document

[pluto1415]

I have a VB module that runs a query, populates a table, then populates a 1 page word document. I can make it create as many letters as there are records in my table, but my users want this to be 1 big document, with 1 page per row. So, if my table has 207 rows, I should get 1 document with 207 pages. I can't figure out how to make it do this.... (at this point, I don't care what it names the big doc)

Private Sub Cmd1MonthFaxUs_Click()
'On Error GoTo ErrorHandler
Dim sInsCo As String
Dim sInsCoFax As String
Dim sPolicyNo As String
Dim sOwner As String
Dim sTrustee As String
Dim sOwnerTID As String
Dim sLastName As String
Dim strTbl As String
Dim strDocName As String
Dim objWord As New Word.Application
Dim MainObjDoc As Word.Document

'DoCmd.SetWarnings (False)
DoCmd.OpenQuery "QryPremConfLetter"


strTbl = "TblMain"

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Select * from " & strTbl & "")
    With rst
    Do While Not rst.EOF
    strDocName = "S:\document preparation\Servicing\PremConfLetter1MonthFaxUs.doc"
    objWord.Documents.Open FileName:=strDocName, PassWordDocument:="SuperSecurePass"
    Set MainObjDoc = objWord.ActiveDocument
    
    sInsCo = rst.Fields("InsCo")
    sInsCoFax = rst.Fields("InsCoFax")
    sPolicyNo = rst.Fields("PolicyNo")
    sOwner = rst.Fields("OwnerName")
    sTrustee = rst.Fields("Trustee")
    sOwnerTID = rst.Fields("OwnerTID")
    sLastName = rst.Fields("LastName")
    
    MainObjDoc.Bookmarks("InsCo").Range.InsertAfter Trim((sInsCo))
    MainObjDoc.Bookmarks("InsCoFax").Range.InsertAfter Trim((sInsCoFax))
    MainObjDoc.Bookmarks("PolicyNo").Range.InsertAfter Trim((sPolicyNo))
    MainObjDoc.Bookmarks("InsCo2").Range.InsertAfter Trim((sInsCo))
    MainObjDoc.Bookmarks("Owner").Range.InsertAfter Trim((sOwner))
    MainObjDoc.Bookmarks("Trustee").Range.InsertAfter Trim((sTrustee))
    MainObjDoc.Bookmarks("OwnerTID").Range.InsertAfter Trim((sOwnerTID))
    MainObjDoc.SaveAs FileName:="R:\servicing\doc prep letters\" & Trim(sLastName) & " - " & Trim(sPolicyNo) & ".doc", Password:=""
    
    Set MainObjDoc = Nothing
    objWord.ActiveDocument.Close
    objWord.Quit
    Set objWord = Nothing
    
    rst.MoveNext
    Loop
    End With

MsgBox "Letters are Ready", vbOKOnly, "Document Preparation"

DoCmd.OpenQuery "QryTblMainDeleteRecords"
'DoCmd.SetWarnings (True)
End Sub

 

[PWise]

for starters lok @ mailmerge

 

[pluto1415]

UGH, do I have to go back to the ugly MailMerge? I was hoping I could do it all via VBA, since I've gotten this far with it.

 

[PWise]

well you can run a mailmerge with VBA

 

[pluto1415]

Yes, but the letter would need to be set up as a MailMerge and all the appropriate fields added, etc.. correct? Then if you want to open the document without opening the Access database that it's connected to, it wants to open Access anyways, or it gives you errors because it can't merge from an unopen DB.