D
Doctorjones_md
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
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
