K
Kevin B
I've got some automation code that errors out when it's called from a form,
displaying error #3021. However, if I insert break points and step through
the code with either F8 or F5 it runs just fine.
The sequence of event is:
1. Capture selected job name from a listbox on a form to an array
2. Create proto-file names using the selected job names and storre to an array
3. Query the table, one job name at a time and store each field value to an
array
4. Open a new word doc, using a template, and populate table 1 w/field data
5. Save and close the document and repeat the loop
I've posted the code below and any tips or suggestions would be greatly
appreciated, I seem to have run out of ideas at this point.
Code follows:
Function GenerateWordDocuments(frm As Form)
'=================================================================
'
' Purpose: Generate Word documents using the requests that
' were selected on Print Request Forms tab of the
' frmMain form
'
' Input: The frmMain form as a form object
'
' Output: Nothing
'
'=================================================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Object variables for the current database, a generic
' recordset object, the list box with the job names and
' three Word objects: the application, the document and the
' first table in the document object
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim dbf As DAO.Database, rst As DAO.Recordset, lstDocRequests _
As ListBox, wdApp As Word.Application, wdDoc As _
Word.Document, wdTbl As Word.Table
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 3 array variables for the selected job names, their
' related document name and the 13 values returned by the
' the query that are used to populate the Word template
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strJobs() As String, strDocs() As String, varVals(12) As _
Variant
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' String variables for the SQL that extracts the data for
' each selected job, the current date as a string used in
' the filename, 3 counters used in various FOR loops and
' a boolean that indicates whether or not Word is up and
' running
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strSQL As String, strDate As String, intDocTot As _
Integer, intFields As Integer, i As Integer, _
blnIsAppRunning As Boolean
On Error GoTo Err_GenerateWordDocuments
'-------------------------------------------------------------
' Assign the list box and the string date to their
' respective variables. Cycle through all the names in the
' list box and capture all selected ones to the strJobs()
' array. The intDocTot variables counts the number of
' selected documents and is used in future FOR loops as a
' control value
'-------------------------------------------------------------
Set lstDocRequests = frm.lstDocRequests
Set dbf = CurrentDb
'Suppress screen activity, disply stat bar message
ScreenOn False, "Capturing job names and generating " & _
"document file names, please wait..."
DoCmd.SetWarnings False
strDate = CStr(Format$(Date, "mm-dd-yyyy"))
With lstDocRequests
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve strJobs(i)
strJobs(i) = .Column(1, i)
intDocTot = intDocTot + 1
End If
Next i
End With
'-------------------------------------------------------------
' With the total number of selected documents counted,
' redimension the strDocs array, and then strip out any
' spaces, replacing them with an underscore, strip out
' any dashes replacing them with nothing and then strip out
' any 2 consectutive underscores replacing them with a
' single underscore. This array holds the future root name
' values which will be assigned to the documents created
' later on in this function
'-------------------------------------------------------------
ReDim strDocs(intDocTot)
For i = 0 To intDocTot - 1
strDocs(i) = Replace(strJobs(i), " ", "_")
strDocs(i) = Replace(strJobs(i), "-", "")
strDocs(i) = Replace(strJobs(i), "__", "_") & strDate
Next i
'-------------------------------------------------------------
' Next step is to create the Word application object. Using
' the UDF IsAppRunning determine whether or not Word is
' listed in the running objects table. If it is use
' GetObject, otherwise use CreateObject to initialize the
' variable
'-------------------------------------------------------------
blnIsAppRunning = IsAppRunning("WinWord.exe")
If blnIsAppRunning Then
Set wdApp = GetObject(, "Word.application")
Else
Set wdApp = CreateObject("Word.Application")
End If
'-------------------------------------------------------------
' The next FOR loop contains a nested FOR and 2 nested WITH
' statements.
'
' The overview is to create a recordset object by querying
' the jobs record. Store each of the field values to the
' varVals array.
'
' With the Word object, create a new document and save it
' using the current strDocs array value. Then loop through
' all the values in the varVals array and place them in the
' appropriate cell in Table 1 of the current document.
'
' When done, resave and close the current document and
' loop to create the next one.
'-------------------------------------------------------------
For i = 0 To intDocTot - 1
ScreenOn False, "Capturing data for the next , " & _
"document, please wait..."
'Recordset query
strSQL = "SELECT * FROM tblPermCycleSetups WHERE (((" & _
"Job_Name)='" & strJobs(i) & "'));"
Set rst = dbf.OpenRecordset(strSQL)
With rst
'Loop through the returned record and capture field
'values
For intFields = 0 To 12
varVals(intFields) = Nz(.Fields(intFields + 1). _
Value, "")
Next intFields
End With
'Activate the word app
With wdApp
'Add andsave a new document and initialize the table
'variable
ScreenOn False, "Creating and save " & strDocs(i) & _
".doc, please wait..."
Set wdDoc = wdApp.Documents.Add(conWDTemp)
wdDoc.SaveAs conDocDir & strDocs(i), FileFormat:=wdFormatDocument
Set wdTbl = wdDoc.Tables(1)
'With the table object, place the 13 values captured from the
'recordset in their corresponding table cell
With wdTbl
For intFields = 0 To 12
Select Case intFields
Case 0
.Cell(1, 2).Range.Text = _
varVals(intFields)
Case 1
.Cell(2, 2).Range.Text = _
varVals(intFields)
Case 2
.Cell(3, 2).Range.Text = _
varVals(intFields)
Case 3
.Cell(4, 2).Range.Text = _
varVals(intFields)
Case 4
.Cell(5, 2).Range.Text = _
varVals(intFields)
Case 5
.Cell(6, 2).Range.Text = _
varVals(intFields)
Case 6
.Cell(7, 2).Range.Text = _
varVals(intFields)
Case 7
.Cell(7, 4).Range.Text = _
varVals(intFields)
Case 8
.Cell(8, 2).Range.Text = _
varVals(intFields)
Case 9
.Cell(8, 4).Range.Text = _
varVals(intFields)
Case 10
.Cell(9, 2).Range.Text = _
varVals(intFields)
Case 11
.Cell(10, 2).Range.Text = _
varVals(intFields)
Case 12
.Cell(11, 2).Range.Text = _
varVals(intFields)
Case Else
End Select
Next intFields
'Save and close the current word document
wdDoc.Save
wdDoc.Close
End With
End With
Next i
wdApp.Quit
Exit_GenerateWordDocuments:
With lstDocRequests
.SetFocus
.Value = Empty
End With
Set dbf = Nothing
Set rst = Nothing
Set lstDocRequests = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
Set wdTbl = Nothing
DoCmd.SetWarnings True
ScreenOn True
Exit Function
Err_GenerateWordDocuments:
If Err.Number = 429 Then Resume Next
ErrTrap Err.Number, conMod, "GenerateWordDocuments", True
wdApp.Quit
Err.Clear
Resume Exit_GenerateWordDocuments
End Function
displaying error #3021. However, if I insert break points and step through
the code with either F8 or F5 it runs just fine.
The sequence of event is:
1. Capture selected job name from a listbox on a form to an array
2. Create proto-file names using the selected job names and storre to an array
3. Query the table, one job name at a time and store each field value to an
array
4. Open a new word doc, using a template, and populate table 1 w/field data
5. Save and close the document and repeat the loop
I've posted the code below and any tips or suggestions would be greatly
appreciated, I seem to have run out of ideas at this point.
Code follows:
Function GenerateWordDocuments(frm As Form)
'=================================================================
'
' Purpose: Generate Word documents using the requests that
' were selected on Print Request Forms tab of the
' frmMain form
'
' Input: The frmMain form as a form object
'
' Output: Nothing
'
'=================================================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Object variables for the current database, a generic
' recordset object, the list box with the job names and
' three Word objects: the application, the document and the
' first table in the document object
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim dbf As DAO.Database, rst As DAO.Recordset, lstDocRequests _
As ListBox, wdApp As Word.Application, wdDoc As _
Word.Document, wdTbl As Word.Table
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 3 array variables for the selected job names, their
' related document name and the 13 values returned by the
' the query that are used to populate the Word template
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strJobs() As String, strDocs() As String, varVals(12) As _
Variant
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' String variables for the SQL that extracts the data for
' each selected job, the current date as a string used in
' the filename, 3 counters used in various FOR loops and
' a boolean that indicates whether or not Word is up and
' running
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strSQL As String, strDate As String, intDocTot As _
Integer, intFields As Integer, i As Integer, _
blnIsAppRunning As Boolean
On Error GoTo Err_GenerateWordDocuments
'-------------------------------------------------------------
' Assign the list box and the string date to their
' respective variables. Cycle through all the names in the
' list box and capture all selected ones to the strJobs()
' array. The intDocTot variables counts the number of
' selected documents and is used in future FOR loops as a
' control value
'-------------------------------------------------------------
Set lstDocRequests = frm.lstDocRequests
Set dbf = CurrentDb
'Suppress screen activity, disply stat bar message
ScreenOn False, "Capturing job names and generating " & _
"document file names, please wait..."
DoCmd.SetWarnings False
strDate = CStr(Format$(Date, "mm-dd-yyyy"))
With lstDocRequests
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve strJobs(i)
strJobs(i) = .Column(1, i)
intDocTot = intDocTot + 1
End If
Next i
End With
'-------------------------------------------------------------
' With the total number of selected documents counted,
' redimension the strDocs array, and then strip out any
' spaces, replacing them with an underscore, strip out
' any dashes replacing them with nothing and then strip out
' any 2 consectutive underscores replacing them with a
' single underscore. This array holds the future root name
' values which will be assigned to the documents created
' later on in this function
'-------------------------------------------------------------
ReDim strDocs(intDocTot)
For i = 0 To intDocTot - 1
strDocs(i) = Replace(strJobs(i), " ", "_")
strDocs(i) = Replace(strJobs(i), "-", "")
strDocs(i) = Replace(strJobs(i), "__", "_") & strDate
Next i
'-------------------------------------------------------------
' Next step is to create the Word application object. Using
' the UDF IsAppRunning determine whether or not Word is
' listed in the running objects table. If it is use
' GetObject, otherwise use CreateObject to initialize the
' variable
'-------------------------------------------------------------
blnIsAppRunning = IsAppRunning("WinWord.exe")
If blnIsAppRunning Then
Set wdApp = GetObject(, "Word.application")
Else
Set wdApp = CreateObject("Word.Application")
End If
'-------------------------------------------------------------
' The next FOR loop contains a nested FOR and 2 nested WITH
' statements.
'
' The overview is to create a recordset object by querying
' the jobs record. Store each of the field values to the
' varVals array.
'
' With the Word object, create a new document and save it
' using the current strDocs array value. Then loop through
' all the values in the varVals array and place them in the
' appropriate cell in Table 1 of the current document.
'
' When done, resave and close the current document and
' loop to create the next one.
'-------------------------------------------------------------
For i = 0 To intDocTot - 1
ScreenOn False, "Capturing data for the next , " & _
"document, please wait..."
'Recordset query
strSQL = "SELECT * FROM tblPermCycleSetups WHERE (((" & _
"Job_Name)='" & strJobs(i) & "'));"
Set rst = dbf.OpenRecordset(strSQL)
With rst
'Loop through the returned record and capture field
'values
For intFields = 0 To 12
varVals(intFields) = Nz(.Fields(intFields + 1). _
Value, "")
Next intFields
End With
'Activate the word app
With wdApp
'Add andsave a new document and initialize the table
'variable
ScreenOn False, "Creating and save " & strDocs(i) & _
".doc, please wait..."
Set wdDoc = wdApp.Documents.Add(conWDTemp)
wdDoc.SaveAs conDocDir & strDocs(i), FileFormat:=wdFormatDocument
Set wdTbl = wdDoc.Tables(1)
'With the table object, place the 13 values captured from the
'recordset in their corresponding table cell
With wdTbl
For intFields = 0 To 12
Select Case intFields
Case 0
.Cell(1, 2).Range.Text = _
varVals(intFields)
Case 1
.Cell(2, 2).Range.Text = _
varVals(intFields)
Case 2
.Cell(3, 2).Range.Text = _
varVals(intFields)
Case 3
.Cell(4, 2).Range.Text = _
varVals(intFields)
Case 4
.Cell(5, 2).Range.Text = _
varVals(intFields)
Case 5
.Cell(6, 2).Range.Text = _
varVals(intFields)
Case 6
.Cell(7, 2).Range.Text = _
varVals(intFields)
Case 7
.Cell(7, 4).Range.Text = _
varVals(intFields)
Case 8
.Cell(8, 2).Range.Text = _
varVals(intFields)
Case 9
.Cell(8, 4).Range.Text = _
varVals(intFields)
Case 10
.Cell(9, 2).Range.Text = _
varVals(intFields)
Case 11
.Cell(10, 2).Range.Text = _
varVals(intFields)
Case 12
.Cell(11, 2).Range.Text = _
varVals(intFields)
Case Else
End Select
Next intFields
'Save and close the current word document
wdDoc.Save
wdDoc.Close
End With
End With
Next i
wdApp.Quit
Exit_GenerateWordDocuments:
With lstDocRequests
.SetFocus
.Value = Empty
End With
Set dbf = Nothing
Set rst = Nothing
Set lstDocRequests = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
Set wdTbl = Nothing
DoCmd.SetWarnings True
ScreenOn True
Exit Function
Err_GenerateWordDocuments:
If Err.Number = 429 Then Resume Next
ErrTrap Err.Number, conMod, "GenerateWordDocuments", True
wdApp.Quit
Err.Clear
Resume Exit_GenerateWordDocuments
End Function