I have code that will export data on an Access form to a Word template with text box fields.
All data exports fine, except a long text field. The Word text box remains blank.
The Word text box is "txtPDescription" and the Access field is "ProjectDescription".
I've tried a number of solutions, and searched for a couple of hours and cannot find a solution that I can understand well enough to use.
Here is the code I am using:
All data exports fine, except a long text field. The Word text box remains blank.
The Word text box is "txtPDescription" and the Access field is "ProjectDescription".
I've tried a number of solutions, and searched for a couple of hours and cannot find a solution that I can understand well enough to use.
Here is the code I am using:
Code:
Private Sub cmdPrintWord_Click()
Dim appword As Word.Application
Dim doc As Word.Document
Dim path As String
path = Me.QCPlanPath
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(path, , True)
With doc
.FormFields("txtProject").Result = Me.[Project Name]
.FormFields("txtContractNumber").Result = Me.Contract_Number
.FormFields("txtPreparedBy").Result = Me.[Prepared By]
.FormFields("txtReviewedBy").Result = Me.[Reviewed By]
.FormFields("txtCost").Result = Me.Cost
.FormFields("txtDuration").Result = Me.Duration
.FormFields("txtFedNumber").Result = Me.Federal_Project_Number
End With
With doc
.FormFields("txtPDescription").Result = "****"
Selection.GoTo what:=wdGoToBookmark, Name:="txtPDescription"
Selection.Collapse
Selection.MoveRight wdCharacter, 1
Selection.TypeText ([Forms]![ProjectDescription]![Field])
Selection.GoTo what:=wdGoToBookmark, Name:="txtPDescription"
' Remove unique characters from Word_Form_Field_Name form field.
With Selection.Find
.Execute findtext:="*", replacewith:="", Replace:=wdReplaceAll
End With
End With
' get all the permits from the subform
Dim rs As Recordset: Set rs = Me.frmQCPlanPermits.Form.RecordsetClone
With rs
.MoveLast
If Not .EOF Then
.MoveLast
.MoveFirst
End If
End With
Dim idx As Integer
For idx = 1 To rs.RecordCount
With doc.Tables(4)
.Cell(idx, 2).Range.Text = Nz(rs!Permit)
.Cell(idx, 3).Range.Text = Nz(rs!Agency)
If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
End With
rs.MoveNext
Next idx
appword.Visible = True
appword.Activate
End Sub