Populate Multiple Word Documents with Recordset

[abroniewski]

Hi there!

I am trying to automate the creation of multiple word documents which are based on a standard template. I create a query using the function "specificQuery" which matches a value on the form "Form New-Batch" to a field in the table "Table-EIRMaster". I then open the recordset of "Query-EIRMaster" (which is set by the specificQuery function). For each record in "Query-EIRMaster", I want to:

1) Create a destination filepath based on specific information from the individual record
2) Create a copy of the template at the new filepath
3) Populate the form fields
4) Save the form

There will be 100's of word documents created this way at once.

My problem currently is:
1) with the recordset. For some reason, it is not being set! Using breakpoints and the immediate window, the value of rs after being set is Nothing. My loop then becomes infinte, as the "If Not (rs.EOF And rs.BOF) Then" statement does not catch this. My PC crashes whenever I run it without breakpoints. There is no problem with "Query-EIRMaster", it is filled with the correct records.
2) What is the best way to handle so many word documents? I used createObject outside of my loop so that Word is only opened once. I've considered the ADODB.Connection method, but the real problem is with the recordset.

Here is my code:

Private Sub cmdGenerateForms_Click()
Dim strSQL As String
Dim strQDF As String
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim lWordDoc As String
Dim appWord As word.Application
Dim doc As word.Document
Dim filePathDestination As String
Dim filePathTemplate As String
Dim strAPPNumber As String

filePathDestination = ""
filePathTemplate = ""
filePathTemplate = FindFile("Response Template", CurrentProject.Path & "\")
Set db = CurrentDb()

'Find all EIRs from a certain batch
specificQuery "Query-EIRMaster", "Table-EIRMaster", "Batch Number", Me!txtBatchNumber

If Trim(Dir(filePathTemplate)) = "" Then 'Error checking of document path
MsgBox "Document not found."
Exit Sub
Else
MsgBox "Response Template Found!", vbExclamation, "Import Template Succesful"
End If

'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Word opens template at lWordDoc location


Set rs = db.OpenRecordset("Query-EIRMaster", dbOpenDynaset) '***After this point, rs remains Nothing

If Not (rs.EOF And rs.BOF) Then
Set appWord = CreateObject(Class:="Word.Application") 'If Word isn't open, create a new instance of Word.
rs.MoveFirst
While Not rs.EOF
strAPPNumber = rs!["APP Number"]
filePathDestination = CurrentProject.Path & "\" & strAPPNumber & "-Response Template" & Format(Now(), "mm-dd-yy_hmAM/PM") & ".doc" ' & rs.Fields("APP Number")
Debug.Print "filePathDestination: " & filePathDestination
FileCopy filePathTemplate, filePathDestination
Set doc = appWord.Documents.Open(fileName:=filePathDestination)

With doc
.FormFields("fldAPPNumber").Result = rs.Fields("APP Number") 'Fields in template are populated
.FormFields("fldDateReceived").Result = rs.Fields("Date Received")
.FormFields("fldDateAssigned").Result = rs.Fields("Date Assigned")
.FormFields("fldPriority").Result = rs.Fields("Priority")
.FormFields("fldResponseIssueDate").Result = rs.Fields("Date Issued")
.FormFields("fldRequestingOrg").Result = rs.Fields("RequestingOrg")
.FormFields("fldPOCMain").Result = rs.Fields("POC Main")
'.FormFields("fldResponseTeam").Result = Me!lstResponse
.FormFields("fldPhase1Date").Result = rs.Fields("Date Phase1")
.FormFields("fldPhase2Date").Result = rs.Fields("Date Phase2")
.FormFields("fldSubCategory").Result = rs.Fields("Category")
.FormFields("fldKeywords").Result = rs.Fields("Keywords")
'.FormFields("fldProjectPhase").Result = Me.ProjectPhase
.FormFields("fldPreamble").Result = rs.Fields("Preamble")
.FormFields("fldRequest").Result = rs.Fields("Request")
.SaveAs fileName:=filePathDestination
.Close (wdSaveChanges)
End With

sleep (5) 'function that uses Time to pause code for 5 seconds
rs.MoveNext
Wend
appWord.Quit
End If
rs.Close
Set rs = Nothing
Set appWord = Nothing
Set doc = Nothing
End Sub

 

[abroniewski]

I have no idea what was wrong with my code. I changed a couple thigns around, and it now works. I have also added in a line of code that creates a new directory for the templates being created. This will save a lot of needless copy/pasting/name changing

Here is my code for those that are interested:
rivate Sub cmdGenerateForms_Click()
Dim strSQL As String
Dim strQDF As String
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim lWordDoc As String
Dim appWord As word.Application
Dim doc As word.Document
Dim filePathDestination As String
Dim filePathTemplate As String
Dim strAPPNumber As String
Dim count As Integer
Dim pathNewBatchFolder As String
filePathDestination = ""
filePathTemplate = ""
If Not IsNull(Me!txtBatchNumber) Then
filePathTemplate = FindFile("Response Template", CurrentProject.Path & "\")
Else
MsgBox "Please select a Batch Tracking #", vbExclamation, "Import Template Succesful"
Exit Sub
End If

'If Dir(filePathTemplate) = 0 Or filePathTemplate = "" Or filePathTemplate = Nothing Then 'Error checking of document path
' MsgBox "Document not found."
' Debug.Print "filePathTemplate: " & filePathTemplate
' Exit Sub
'Else
' MsgBox "Response Template Found!", vbExclamation, "Import Template Succesful"
'End If
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Word opens template at lWordDoc location
Set db = CurrentDb()
'Find all EIRs from a certain batch
specificQuery "Query-EIRMaster", "Table-EIRMaster", "Batch Number", Me!txtBatchNumber
pathNewBatchFolder = CurrentProject.Path & "\FERC-" & Format(Me!txtBatchNumber, "000")
MkDir pathNewBatchFolder
Set rs = db.OpenRecordset("Query-EIRMaster", dbOpenDynaset)
If Not (rs.EOF And rs.BOF) Then
Set appWord = CreateObject(Class:="Word.Application") 'If Word isn't open, create a new instance of Word.
rs.MoveFirst
While Not rs.EOF
strAPPNumber = rs.Fields("APP Number")
filePathDestination = pathNewBatchFolder & "\" & strAPPNumber & " -Response Template- " & Format(Now(), "mm-dd-yy_hmam/pm") & ".doc" ' & rs.Fields("APP Number")
Debug.Print "strAPPNumber: " & strAPPNumber
FileCopy filePathTemplate, filePathDestination
Set doc = appWord.Documents.Open(fileName:=filePathDestination)
With doc
.FormFields("fldAPPNumber").Result = rs.Fields("APP Number") 'Fields in template are populated
.FormFields("fldDateReceived").Result = rs.Fields("Date Received")
.FormFields("fldDateAssigned").Result = rs.Fields("Date Assigned")
.FormFields("fldPriority").Result = rs.Fields("Priority")
.FormFields("fldResponseIssueDate").Result = rs.Fields("Date Issued")
.FormFields("fldRequestingOrg").Result = rs.Fields("RequestingOrg")
.FormFields("fldPOCMain").Result = rs.Fields("POC Main")
'.FormFields("fldResponseTeam").Result = Me!lstResponse
.FormFields("fldPhase1Date").Result = rs.Fields("Date Phase1")
.FormFields("fldPhase2Date").Result = rs.Fields("Date Phase2")
.FormFields("fldSubCategory").Result = rs.Fields("Category")
.FormFields("fldKeywords").Result = rs.Fields("Keywords")
'.FormFields("fldProjectPhase").Result = Me.ProjectPhase
.FormFields("fldPreamble").Result = rs.Fields("Preamble")
.FormFields("fldRequest").Result = rs.Fields("Request")
.SaveAs fileName:=filePathDestination
.Close (wdSaveChanges)
End With
count = count + 1
sleep (0.1)
rs.MoveNext
Wend
appWord.Quit
MsgBox count & " new Response Form(s) generated in the following location:" & vbCrLf & pathNewBatchFolder, vbExclamation, "Response Forms Generated"
Else
MsgBox "No new Response Forms were generated", vbExclamation, "Response Forms Not Generated"
End If

rs.Close
Set rs = Nothing
Set appWord = Nothing
Set doc = Nothing
End Sub