Copy Data From an ACCESS form to a Text From Field in a WO..

I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL
Server). I have a series of Queries that manipulate the data and populate
an ACCESS Form. This Form has the following features:

1. A Main Form, with several pages (Tabs) which display data from one
(OverallData) Table
a. One of these pages (Tabs) contains a Sub-Form which displays data
from another (SpecificData) Table

Here's my quandry ... I'm trying to display (in the WORD template) a field
from the Sub-Form -- how do I modify the code-syntax to accomplish this?
Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)

NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is
populated from a seperate table) -- what do I need to modify to accomplish
this?



I have the following code which I use to display the data (via Text Form
Fields) in my WORD document:
======================================
Option Compare Database
Option Explicit

Dim path As String

Const DOC_PATH1 As String = "\\Fileserver\Products\ "

Const DOC_NAME1 As String = _

"Products1.dot"

Const DOC_PATH2 As String = "\\Fileserver\Products\ "

Const DOC_NAME2 As String = _

" Products2.dot "

Const DOC_PATH3 As String = "\\Fileserver\Products\ "

Const DOC_NAME3 As String = _

" Products3.dot "

Private Sub AddPicture_Click()

' Use the Office File Open dialog to get a file name to use

' as an employee picture.

getFileName

End Sub

Private Sub cmdPrint Products1_Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

Set appWord = GetObject(, "Word.application")

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME1)

If Err = 0 Then

If MsgBox("Do you want to save the current document " _

& "before updating the data?", vbYesNo) = vbYes Then

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True)

Set rst = New ADODB.Recordset



strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

strReportsTo = Nz(rst.Fields(0).Value)

rst.Close

End If



With doc

.FormFields("fldCompanyName").result = Nz(Me!CompanyName)

.FormFields("fldAddress1").result = Nz(Me!Address1)

.FormFields("fldAddress2").result = Nz(Me!Address2)

.FormFields("fldCity").result = Nz(Me!City)

.FormFields("fldRegion").result = Nz(Me!Region)

.FormFields("fldPostalCode").result = Nz(Me!PostalCode)

.FormFields("fldProductName").result = Nz(Me!ProductName)

.FormFields("fldQty").result = Nz(Me!Qty)

.FormFields("fldPrice").result = Nz(Me!Price)

.FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)



End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub



Private Sub cmdPrintProducts2 _Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

Set appWord = GetObject(, "Word.application")

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME2)

If Err = 0 Then

If MsgBox("Do you want to save the current document " _

& "before updating the data?", vbYesNo) = vbYes Then

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True)

Set rst = New ADODB.Recordset



strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

strReportsTo = Nz(rst.Fields(0).Value)

rst.Close

End If



With doc

.FormFields("fldCompanyName").result = Nz(Me!CompanyName)

.FormFields("fldAddress1").result = Nz(Me!Address1)

.FormFields("fldAddress2").result = Nz(Me!Address2)

.FormFields("fldCity").result = Nz(Me!City)

.FormFields("fldRegion").result = Nz(Me!Region)

.FormFields("fldPostalCode").result = Nz(Me!PostalCode)

.FormFields("fldProductName").result = Nz(Me!ProductName)

.FormFields("fldQty").result = Nz(Me!Qty)

.FormFields("fldPrice").result = Nz(Me!Price)

.FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)

End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub





Private Sub cmdPrintProducts3_Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

Set appWord = GetObject(, "Word.application")

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME3)

If Err = 0 Then

If MsgBox("Do you want to save the current document " _

& "before updating the data?", vbYesNo) = vbYes Then

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True)

Set rst = New ADODB.Recordset





strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

strReportsTo = Nz(rst.Fields(0).Value)

rst.Close

End If



With doc

.FormFields("fldCompanyName").result = Nz(Me!CompanyName)

.FormFields("fldAddress1").result = Nz(Me!Address1)

.FormFields("fldAddress2").result = Nz(Me!Address2)

.FormFields("fldCity").result = Nz(Me!City)

.FormFields("fldRegion").result = Nz(Me!Region)

.FormFields("fldPostalCode").result = Nz(Me!PostalCode)

.FormFields("fldProductName").result = Nz(Me!ProductName)

.FormFields("fldQty").result = Nz(Me!Qty)

.FormFields("fldPrice").result = Nz(Me!Price)

.FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)

End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub

================================================================

The REST of the code is deleted for ease-of-viewing

================================================================



Private Sub Form_RecordExit(Cancel As Integer)

' Hide the errormsg label to reduce flashing when navigating

' between records.

errormsg.Visible = False

End Sub

Private Sub RemovePicture_Click()

' Clear the file name for the employee record and display the

' errormsg label.

Me![ImagePath] = ""

hideImageFrame

errormsg.Visible = True

End Sub



Private Sub Form_AfterUpdate()

' Requery the ReportsTo combo box after a record has been changed.

' Then, either show the errormsg label if no file name exists for

' the employee record or display the image if there is a file name that

' exists.

'Me!ReportsTo.Requery

On Error Resume Next

showErrorMessage

showImageFrame

If (IsRelative(Me!ImagePath) = True) Then

Me![ImageFrame].Picture = path & Me![ImagePath]

Else

Me![ImageFrame].Picture = Me![ImagePath]

End If

End Sub



Private Sub ImagePath_AfterUpdate()

' After selecting an image for the employee, display it.

On Error Resume Next

showErrorMessage

showImageFrame

If (IsRelative(Me!ImagePath) = True) Then

Me![ImageFrame].Picture = path & Me![ImagePath]

Else

Me![ImageFrame].Picture = Me![ImagePath]

End If

End Sub

Private Sub Form_Current()

' Display the picture for the current employee record if the image

' exists. If the file name no longer exists or the file name was blank

' for the current employee, set the errormsg label caption to the

' appropriate message.

Dim res As Boolean

Dim fName As String



path = CurrentProject.path

On Error Resume Next

errormsg.Visible = False

If Not IsNull(Me!Photo) Then

res = IsRelative(Me!Photo)

fName = Me![ImagePath]

If (res = True) Then

fName = path & "\" & fName

End If



Me![ImageFrame].Picture = fName

showImageFrame

Me.PaintPalette = Me![ImageFrame].ObjectPalette

If (Me![ImageFrame].Picture <> fName) Then

hideImageFrame

errormsg.Caption = "Picture not found"

errormsg.Visible = True

End If

Else

hideImageFrame

errormsg.Caption = "Click Add/Change to add picture"

errormsg.Visible = True

End If



End Sub



Sub getFileName()

' Displays the Office File Open dialog to choose a file name

' for the current employee record. If the user selects a file

' display it in the image control.

Dim fileName As String

Dim result As Integer

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "Select Employee Picture"

.Filters.Add "All Files", "*.*"

.Filters.Add "JPEGs", "*.jpg"

.Filters.Add "Bitmaps", "*.bmp"

.FilterIndex = 3

.AllowMultiSelect = False

.InitialFileName = CurrentProject.path

result = .Show

If (result <> 0) Then

fileName = Trim(.SelectedItems.Item(1))

Me![ImagePath].Visible = True

Me![ImagePath].SetFocus

Me![ImagePath].Text = fileName

Me![FirstName].SetFocus

Me![ImagePath].Visible = False

End If

End With

End Sub



Sub showErrorMessage()

' Display the errormsg label if the image file is not available.

If Not IsNull(Me!Photo) Then

errormsg.Visible = False

Else

errormsg.Visible = True

End If

End Sub



Function IsRelative(fName As String) As Boolean

' Return false if the file name contains a drive or UNC path

IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)

End Function



Sub hideImageFrame()

' Hide the image control

Me![ImageFrame].Visible = False

End Sub



Sub showImageFrame()

' Display the image control

Me![ImageFrame].Visible = True

End Sub

What happens when you run your code now?

If you put a

MsgBox Nz(Me!DeliveryFee)

command in your code, what does it display?

Also, what does MsgBox Me!GrossPurchaseTotal display?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

"Doctorjones_md" <xxxDoctorjones_mdxxx.DeleteThis@xxxyahoo.com> wrote in message
news:%23FoxEbnjHHA.4188@TK2MSFTNGP02.phx.gbl...
>I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL
> Server). I have a series of Queries that manipulate the data and populate
> an ACCESS Form. This Form has the following features:
>
> 1. A Main Form, with several pages (Tabs) which display data from one
> (OverallData) Table
> a. One of these pages (Tabs) contains a Sub-Form which displays data
> from another (SpecificData) Table
>
> Here's my quandry ... I'm trying to display (in the WORD template) a field
> from the Sub-Form -- how do I modify the code-syntax to accomplish this?
> Example: .FormFields("fldDeliveryFee").result =
> Nz(Me!DeliveryFee)
>
> NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is
> populated from a seperate table) -- what do I need to modify to accomplish
> this?
>
>
>
> I have the following code which I use to display the data (via Text Form
> Fields) in my WORD document:
> ======================================
> Option Compare Database
> Option Explicit
>
> Dim path As String
>
> Const DOC_PATH1 As String = "\\Fileserver\Products\ "
>
> Const DOC_NAME1 As String = _
>
> "Products1.dot"
>
> Const DOC_PATH2 As String = "\\Fileserver\Products\ "
>
> Const DOC_NAME2 As String = _
>
> " Products2.dot "
>
> Const DOC_PATH3 As String = "\\Fileserver\Products\ "
>
> Const DOC_NAME3 As String = _
>
> " Products3.dot "
>
> Private Sub AddPicture_Click()
>
> ' Use the Office File Open dialog to get a file name to use
>
> ' as an employee picture.
>
> getFileName
>
> End Sub
>
> Private Sub cmdPrint Products1_Click()
>
> Dim appWord As Word.Application
>
> Dim doc As Word.Document
>
> Dim rst As ADODB.Recordset
>
> Dim strSQL As String
>
> Dim strReportsTo As String
>
>
>
> On Error Resume Next
>
> Set appWord = GetObject(, "Word.application")
>
> If Err = 429 Then
>
> Set appWord = New Word.Application
>
> Err = 0
>
> End If
>
>
>
> With appWord
>
> Set doc = .Documents(DOC_NAME1)
>
> If Err = 0 Then
>
> If MsgBox("Do you want to save the current document " _
>
> & "before updating the data?", vbYesNo) = vbYes Then
>
> .Dialogs(wdDialogFileSaveAs).Show
>
> End If
>
> doc.Close False
>
> End If
>
>
>
> On Error GoTo ErrorHandler
>
>
>
> Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True)
>
> Set rst = New ADODB.Recordset
>
>
>
> strSQL = "SELECT * FROM PRODUCTS"
>
> rst.Open strSQL, CurrentProject.Connection, _
>
> adOpenStatic, adLockReadOnly
>
> If Not rst.EOF Then
>
> strReportsTo = Nz(rst.Fields(0).Value)
>
> rst.Close
>
> End If
>
>
>
> With doc
>
> .FormFields("fldCompanyName").result = Nz(Me!CompanyName)
>
> .FormFields("fldAddress1").result = Nz(Me!Address1)
>
> .FormFields("fldAddress2").result = Nz(Me!Address2)
>
> .FormFields("fldCity").result = Nz(Me!City)
>
> .FormFields("fldRegion").result = Nz(Me!Region)
>
> .FormFields("fldPostalCode").result = Nz(Me!PostalCode)
>
> .FormFields("fldProductName").result = Nz(Me!ProductName)
>
> .FormFields("fldQty").result = Nz(Me!Qty)
>
> .FormFields("fldPrice").result = Nz(Me!Price)
>
> .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)
>
>
>
> End With
>
> .Visible = True
>
> .Activate
>
> End With
>
>
>
> Set rst = Nothing
>
> Set doc = Nothing
>
> Set appWord = Nothing
>
> Exit Sub
>
>
>
> ErrorHandler:
>
> MsgBox Err & Err.Description
>
> End Sub
>
>
>
> Private Sub cmdPrintProducts2 _Click()
>
> Dim appWord As Word.Application
>
> Dim doc As Word.Document
>
> Dim rst As ADODB.Recordset
>
> Dim strSQL As String
>
> Dim strReportsTo As String
>
>
>
> On Error Resume Next
>
> Set appWord = GetObject(, "Word.application")
>
> If Err = 429 Then
>
> Set appWord = New Word.Application
>
> Err = 0
>
> End If
>
>
>
> With appWord
>
> Set doc = .Documents(DOC_NAME2)
>
> If Err = 0 Then
>
> If MsgBox("Do you want to save the current document " _
>
> & "before updating the data?", vbYesNo) = vbYes Then
>
> .Dialogs(wdDialogFileSaveAs).Show
>
> End If
>
> doc.Close False
>
> End If
>
>
>
> On Error GoTo ErrorHandler
>
>
>
> Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True)
>
> Set rst = New ADODB.Recordset
>
>
>
> strSQL = "SELECT * FROM PRODUCTS"
>
> rst.Open strSQL, CurrentProject.Connection, _
>
> adOpenStatic, adLockReadOnly
>
> If Not rst.EOF Then
>
> strReportsTo = Nz(rst.Fields(0).Value)
>
> rst.Close
>
> End If
>
>
>
> With doc
>
> .FormFields("fldCompanyName").result = Nz(Me!CompanyName)
>
> .FormFields("fldAddress1").result = Nz(Me!Address1)
>
> .FormFields("fldAddress2").result = Nz(Me!Address2)
>
> .FormFields("fldCity").result = Nz(Me!City)
>
> .FormFields("fldRegion").result = Nz(Me!Region)
>
> .FormFields("fldPostalCode").result = Nz(Me!PostalCode)
>
> .FormFields("fldProductName").result = Nz(Me!ProductName)
>
> .FormFields("fldQty").result = Nz(Me!Qty)
>
> .FormFields("fldPrice").result = Nz(Me!Price)
>
> .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)
>
> End With
>
> .Visible = True
>
> .Activate
>
> End With
>
>
>
> Set rst = Nothing
>
> Set doc = Nothing
>
> Set appWord = Nothing
>
> Exit Sub
>
>
>
> ErrorHandler:
>
> MsgBox Err & Err.Description
>
> End Sub
>
>
>
>
>
> Private Sub cmdPrintProducts3_Click()
>
> Dim appWord As Word.Application
>
> Dim doc As Word.Document
>
> Dim rst As ADODB.Recordset
>
> Dim strSQL As String
>
> Dim strReportsTo As String
>
>
>
> On Error Resume Next
>
> Set appWord = GetObject(, "Word.application")
>
> If Err = 429 Then
>
> Set appWord = New Word.Application
>
> Err = 0
>
> End If
>
>
>
> With appWord
>
> Set doc = .Documents(DOC_NAME3)
>
> If Err = 0 Then
>
> If MsgBox("Do you want to save the current document " _
>
> & "before updating the data?", vbYesNo) = vbYes Then
>
> .Dialogs(wdDialogFileSaveAs).Show
>
> End If
>
> doc.Close False
>
> End If
>
>
>
> On Error GoTo ErrorHandler
>
>
>
> Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True)
>
> Set rst = New ADODB.Recordset
>
>
>
>
>
> strSQL = "SELECT * FROM PRODUCTS"
>
> rst.Open strSQL, CurrentProject.Connection, _
>
> adOpenStatic, adLockReadOnly
>
> If Not rst.EOF Then
>
> strReportsTo = Nz(rst.Fields(0).Value)
>
> rst.Close
>
> End If
>
>
>
> With doc
>
> .FormFields("fldCompanyName").result = Nz(Me!CompanyName)
>
> .FormFields("fldAddress1").result = Nz(Me!Address1)
>
> .FormFields("fldAddress2").result = Nz(Me!Address2)
>
> .FormFields("fldCity").result = Nz(Me!City)
>
> .FormFields("fldRegion").result = Nz(Me!Region)
>
> .FormFields("fldPostalCode").result = Nz(Me!PostalCode)
>
> .FormFields("fldProductName").result = Nz(Me!ProductName)
>
> .FormFields("fldQty").result = Nz(Me!Qty)
>
> .FormFields("fldPrice").result = Nz(Me!Price)
>
> .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee)
>
> End With
>
> .Visible = True
>
> .Activate
>
> End With
>
>
>
> Set rst = Nothing
>
> Set doc = Nothing
>
> Set appWord = Nothing
>
> Exit Sub
>
>
>
> ErrorHandler:
>
> MsgBox Err & Err.Description
>
> End Sub
>
> ================================================================
>
> The REST of the code is deleted for ease-of-viewing
>
> ================================================================
>
>
>
> Private Sub Form_RecordExit(Cancel As Integer)
>
> ' Hide the errormsg label to reduce flashing when navigating
>
> ' between records.
>
> errormsg.Visible = False
>
> End Sub
>
> Private Sub RemovePicture_Click()
>
> ' Clear the file name for the employee record and display the
>
> ' errormsg label.
>
> Me![ImagePath] = ""
>
> hideImageFrame
>
> errormsg.Visible = True
>
> End Sub
>
>
>
> Private Sub Form_AfterUpdate()
>
> ' Requery the ReportsTo combo box after a record has been changed.
>
> ' Then, either show the errormsg label if no file name exists for
>
> ' the employee record or display the image if there is a file name that
>
> ' exists.
>
> 'Me!ReportsTo.Requery
>
> On Error Resume Next
>
> showErrorMessage
>
> showImageFrame
>
> If (IsRelative(Me!ImagePath) = True) Then
>
> Me![ImageFrame].Picture = path & Me![ImagePath]
>
> Else
>
> Me![ImageFrame].Picture = Me![ImagePath]
>
> End If
>
> End Sub
>
>
>
> Private Sub ImagePath_AfterUpdate()
>
> ' After selecting an image for the employee, display it.
>
> On Error Resume Next
>
> showErrorMessage
>
> showImageFrame
>
> If (IsRelative(Me!ImagePath) = True) Then
>
> Me![ImageFrame].Picture = path & Me![ImagePath]
>
> Else
>
> Me![ImageFrame].Picture = Me![ImagePath]
>
> End If
>
> End Sub
>
> Private Sub Form_Current()
>
> ' Display the picture for the current employee record if the image
>
> ' exists. If the file name no longer exists or the file name was blank
>
> ' for the current employee, set the errormsg label caption to the
>
> ' appropriate message.
>
> Dim res As Boolean
>
> Dim fName As String
>
>
>
> path = CurrentProject.path
>
> On Error Resume Next
>
> errormsg.Visible = False
>
> If Not IsNull(Me!Photo) Then
>
> res = IsRelative(Me!Photo)
>
> fName = Me![ImagePath]
>
> If (res = True) Then
>
> fName = path & "\" & fName
>
> End If
>
>
>
> Me![ImageFrame].Picture = fName
>
> showImageFrame
>
> Me.PaintPalette = Me![ImageFrame].ObjectPalette
>
> If (Me![ImageFrame].Picture <> fName) Then
>
> hideImageFrame
>
> errormsg.Caption = "Picture not found"
>
> errormsg.Visible = True
>
> End If
>
> Else
>
> hideImageFrame
>
> errormsg.Caption = "Click Add/Change to add picture"
>
> errormsg.Visible = True
>
> End If
>
>
>
> End Sub
>
>
>
> Sub getFileName()
>
> ' Displays the Office File Open dialog to choose a file name
>
> ' for the current employee record. If the user selects a file
>
> ' display it in the image control.
>
> Dim fileName As String
>
> Dim result As Integer
>
> With Application.FileDialog(msoFileDialogFilePicker)
>
> .Title = "Select Employee Picture"
>
> .Filters.Add "All Files", "*.*"
>
> .Filters.Add "JPEGs", "*.jpg"
>
> .Filters.Add "Bitmaps", "*.bmp"
>
> .FilterIndex = 3
>
> .AllowMultiSelect = False
>
> .InitialFileName = CurrentProject.path
>
> result = .Show
>
> If (result <> 0) Then
>
> fileName = Trim(.SelectedItems.Item(1))
>
> Me![ImagePath].Visible = True
>
> Me![ImagePath].SetFocus
>
> Me![ImagePath].Text = fileName
>
> Me![FirstName].SetFocus
>
> Me![ImagePath].Visible = False
>
> End If
>
> End With
>
> End Sub
>
>
>
> Sub showErrorMessage()
>
> ' Display the errormsg label if the image file is not available.
>
> If Not IsNull(Me!Photo) Then
>
> errormsg.Visible = False
>
> Else
>
> errormsg.Visible = True
>
> End If
>
> End Sub
>
>
>
> Function IsRelative(fName As String) As Boolean
>
> ' Return false if the file name contains a drive or UNC path
>
> IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)
>
> End Function
>
>
>
> Sub hideImageFrame()
>
> ' Hide the image control
>
> Me![ImageFrame].Visible = False
>
> End Sub
>
>
>
> Sub showImageFrame()
>
> ' Display the image control
>
> Me![ImageFrame].Visible = True
>
> End Sub
>
>