Copy Data From an ACCESS form to a WORD Template

Doctorjones_md · May 4, 2007

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

Pat Hartman \(MVP\) · May 4, 2007

The syntax for referring to fields in a subform is -
Me.sfrmName.Form!controlName

This reference refers to the CURRENT record in the subform. If the subform
is continuous so that it shows multiple records, you will need to be more
sophisticated in your approach. What I do in this case is create a long
text string by looping through the recordset. I separate fields with the
vbTab and use vbCr to separate rows. Then I insert the text at a
bookmark/formfield and convert the text to a table. You can use any of the
standard table formats or format your own specifically.

InsertTextAtBookMark bkmk, strTable
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True

Doctorjones_md said:
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

Doctorjones_md · May 4, 2007

Pat,

Thank you for the insight into how to go about making this work -- my
Sub-Form is indeed a continuous form (rather than a single form). Your
proposed method is a little daunting to me, but it sounds exactly what I'm
looking for. Could you please provide me just a bit more detail (sample
code would be great) just to get me pointed in the right direction.

Pat Hartman (MVP) said:
The syntax for referring to fields in a subform is -
Me.sfrmName.Form!controlName

This reference refers to the CURRENT record in the subform. If the
subform is continuous so that it shows multiple records, you will need to
be more sophisticated in your approach. What I do in this case is create
a long text string by looping through the recordset. I separate fields
with the vbTab and use vbCr to separate rows. Then I insert the text at a
bookmark/formfield and convert the text to a table. You can use any of
the standard table formats or format your own specifically.

InsertTextAtBookMark bkmk, strTable
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True

Doctorjones_md said:

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

Click to expand...

Guest · May 6, 2007

--
msnews.microsoft.com

U¿ytkownik "Doctorjones_md said:
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

Guest · May 6, 2007

--
msnews.microsoft.com

U¿ytkownik "Doctorjones_md said:
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

Pat Hartman \(MVP\) · May 7, 2007

OK, here is the section of code that creates the string that is passed to
the sub I posted earlier. The code opens a query that takes one parameter -
the variable data header ID. It then loops through the recordset,
concatenating the text string returned. When there are no more records, the
loop ends and the string is passed to the sub that makes it a table in word.
In the case of this code, only one field from the table is used and so only
the ending vbCr is needed. If you were using multiple fields, then the code
would look like:

sTableItems = sTableItems & iSeqNum & ". " & rsDAO!SubjectiveText & vbTab &
rsDAO!otherfield1 & rsDAO!otherfield2 & vbCr

'Open subjectivities recordset
Set qdDAO = db.QueryDefs!qMergeSubjectivities
qdDAO.Parameters![EnterVariableDataHeaderID] =
Me.txtVariableDataHeaderID
Set rsDAO = qdDAO.OpenRecordset
sTableItems = ""
If rsDAO.EOF Then
Else
iSeqNum = 0
Do While rsDAO.EOF = False
iSeqNum = iSeqNum + 1
sTableItems = sTableItems & iSeqNum & ". " &
rsDAO!SubjectiveText & vbCr <------alternate version above
rsDAO.MoveNext
Loop
End If
Set qdDAO = Nothing
If sTableItems <> "" Then
sTableItems = Left(sTableItems, Len(sTableItems) - 1) 'remove
final vbCr to eliminate extra line at end
Call Finish1Column("Subjectivities_Items", sTableItems)
end if

Doctorjones_md said:
Pat,

Thank you for the insight into how to go about making this work -- my
Sub-Form is indeed a continuous form (rather than a single form). Your
proposed method is a little daunting to me, but it sounds exactly what I'm
looking for. Could you please provide me just a bit more detail (sample
code would be great) just to get me pointed in the right direction.

Pat Hartman (MVP) said:

The syntax for referring to fields in a subform is -
Me.sfrmName.Form!controlName

This reference refers to the CURRENT record in the subform. If the
subform is continuous so that it shows multiple records, you will need to
be more sophisticated in your approach. What I do in this case is create
a long text string by looping through the recordset. I separate fields
with the vbTab and use vbCr to separate rows. Then I insert the text at
a bookmark/formfield and convert the text to a table. You can use any of
the standard table formats or format your own specifically.

InsertTextAtBookMark bkmk, strTable
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True

Doctorjones_md said:

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

Click to expand...

Click to expand...

Doctorjones_md · May 8, 2007

Pat,

I want to make sure that I'm following you correctly --

My Main Form pulls from a QUERY titled -- Requery Main Form Data Dev, and my
Sub-Form pulls from a TABLE named -- ProposalSpecificsDev -- I'm lost
here -- in your code below -- QueryDefs is the name of the database --
correct? Is qMergeSubjectivities the name of the Query/Record Source for
the Sub-Form or for the Main Form?

Set qdDAO = db.QueryDefs!qMergeSubjectivities
qdDAO.Parameters![EnterVariableDataHeaderID] =
Me.txtVariableDataHeaderID

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

Here's what I understand: ...
'This piece of code copies the Requery_Specifics sub-form data to a WORD
template
Set qdDAO = db.Demo!qMergeSubjectivities (where Demo is the name of the
ACCESS db -- correct? I'm lost here ...
qdDAO.Parameters![Product Type] = Me.txtProductType (where Product
Type is the field in the Table, and where Me.txtProductType is the field on
the
subform -- correct?)
Set rsDAO = qdDAO.OpenRecordset
sTableItems = ""
If rsDAO.EOF Then
Else
iSeqNum = 0
Do While rsDAO.EOF = False
iSeqNum = iSeqNum + 1
sTableItems = sTableItems & iSeqNum & ". " & rsDAO![Product
Type] & vbTab & rsDAO!Quantity & rsDAO![Product Name] & vbCr 'My Version
rsDAO.MoveNext
Loop
End If
Set qdDAO = Nothing
If sTableItems <> "" Then
sTableItems = Left(sTableItems, Len(sTableItems) - 1) 'Removes final
vbCr to eliminate extra line at end

Call Finish1Column("Subjectivities_Items", sTableItems) (I'm not
certain what this Call does)
End If

Where does this piece of code get inserted? In ACCESS, but

InsertTextAtBookMark bkmk, strTable (Shouldn't this be strTableItems? bkmk
is the name of the bookmark in my WORD document -- is this correct?)
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True
============

Pat Hartman \(MVP\) · May 9, 2007

qMergeSubjectivities is the name of the query that contains the data I want
to place in the word document. It takes a parameter so that I can control
what is selected and make sure that only the child records related to the
specific parent record (Me.txtVariableDataHeaderID is the key of the parent
record on the main form).

Doctorjones_md · May 11, 2007

Pat,

I apologize, but I having some difficulties following your guidance.

I don't really understand the code though -- specifically, I don't
understand why I need to specify the database (when I've already established
the connection)

When I run the sub, I get the following error message:
"Compile Error:
Method or data not found"

In the VBE, ".Demo" (SEE BELOW) is highlighted in my code:
Set qdDAO = db.Demo!qPurchaseHistory 'where Demo is the name of the
ACCESS db, and qPurchaseHistory is the name of the Query
qdDAO.Parameters![Enter Product ID] = Me.txtProductID

Any thoughts?

Here's the portion of code in question:
=================================================================
'This piece of code copies the Requery_Specifics sub-form data to a WORD
template
Set qdDAO = db.Demo!qPurchaseHistory 'where Demo is the name of the
ACCESS db, and qPurchaseHistory is the name of the Query
qdDAO.Parameters![Enter Product ID] = Me.txtProductID
Set rsDAO = qdDAO.OpenRecordset
sTableItems = ""
If rsDAO.EOF Then
Else
iSeqNum = 0
Do While rsDAO.EOF = False
iSeqNum = iSeqNum + 1
sTableItems = sTableItems & iSeqNum & ". " & rsDAO!ProductID &
vbTab & rsDAO![Product Name] & vbCr
rsDAO.MoveNext
Loop
End If
Set qdDAO = Nothing
If sTableItems <> "" Then
sTableItems = Left(sTableItems, Len(sTableItems) - 1) 'Removes final
vbCr to eliminate extra line at end

Call Finish1Column("Subjectivities_Items", sTableItems) 'I'm not
certain what this Call does -- I'm certain that I'm supposed to alter
End If

InsertTextAtBookMark ProductName, strTableItems
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True

End Sub

When I run the sub, I get the following error message:
"Compile Error:
Method or data not found"

In the VBE, ".Demo" (SEE BELOW) is highlighted in my code:
Set qdDAO = db.Demo!qPurchaseHistory 'where Demo is the name of the
ACCESS db, and qPurchaseHistory is the name of the Query
qdDAO.Parameters![Enter Product ID] = Me.txtProductID
=================================================================

Thank you for all you help with this Pat.

Pat Hartman (MVP) said:
qMergeSubjectivities is the name of the query that contains the data I
want to place in the word document. It takes a parameter so that I can
control what is selected and make sure that only the child records related
to the specific parent record (Me.txtVariableDataHeaderID is the key of
the parent record on the main form).

Doctorjones_md said:

Pat,

I want to make sure that I'm following you correctly --

My Main Form pulls from a QUERY titled -- Requery Main Form Data Dev, and
my Sub-Form pulls from a TABLE named -- ProposalSpecificsDev -- I'm lost
here -- in your code below -- QueryDefs is the name of the database --
correct? Is qMergeSubjectivities the name of the Query/Record Source for
the Sub-Form or for the Main Form?

Set qdDAO = db.QueryDefs!qMergeSubjectivities
qdDAO.Parameters![EnterVariableDataHeaderID] =
Me.txtVariableDataHeaderID

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

Here's what I understand: ...
'This piece of code copies the Requery_Specifics sub-form data to a WORD
template
Set qdDAO = db.Demo!qMergeSubjectivities (where Demo is the name of
the ACCESS db -- correct? I'm lost here ...
qdDAO.Parameters![Product Type] = Me.txtProductType (where
Product Type is the field in the Table, and where Me.txtProductType is
the field on the subform -- correct?)
Set rsDAO = qdDAO.OpenRecordset
sTableItems = ""
If rsDAO.EOF Then
Else
iSeqNum = 0
Do While rsDAO.EOF = False
iSeqNum = iSeqNum + 1
sTableItems = sTableItems & iSeqNum & ". " & rsDAO![Product
Type] & vbTab & rsDAO!Quantity & rsDAO![Product Name] & vbCr 'My Version
rsDAO.MoveNext
Loop
End If
Set qdDAO = Nothing
If sTableItems <> "" Then
sTableItems = Left(sTableItems, Len(sTableItems) - 1) 'Removes
final vbCr to eliminate extra line at end

Call Finish1Column("Subjectivities_Items", sTableItems) (I'm not
certain what this Call does)
End If

Where does this piece of code get inserted? In ACCESS, but

InsertTextAtBookMark bkmk, strTable (Shouldn't this be strTableItems?
bkmk is the name of the bookmark in my WORD document -- is this correct?)
Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True,
applyHeadingrows:=False, AutoFit:=True
============

Click to expand...

Tom Wickerath MDB · May 24, 2007

wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

Doctorjones_md said:
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

'69 Camaro · May 24, 2007

Everyone please note that Aaron Kem.pf is attempting to impersonate one of
our regular posters again. Tom would never post such a message.

HTH.
Gunny

See http://www.QBuilt.com for all your database needs.
See http://www.Access.QBuilt.com for Microsoft Access tips and tutorials.
Blogs: www.DataDevilDog.BlogSpot.com, www.DatabaseTips.BlogSpot.com
http://www.Access.QBuilt.com/html/expert_contributors2.html for contact
info.

Tom Wickerath MDB said:
wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

Doctorjones_md said:

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

Click to expand...

Douglas J. Steele · May 24, 2007

Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

Tom Wickerath MDB said:
wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

Doctorjones_md said:

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

Click to expand...

Doctorjones_md · May 24, 2007

I appreciate the explanation (and concern) Doug and 69 -- thanks.

Douglas J. Steele said:
Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

Tom Wickerath MDB said:

wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

Doctorjones_md said:

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

Click to expand...

Click to expand...

Tom Wimpernark · May 30, 2007

Doc

just because these people slander me; it doesn't make me wrong.

Anyone using MDB in the year 2007 should be fired and then spit upon.
It is the equivalent of using LEECHES in the medical field

Doctorjones_md said:
I appreciate the explanation (and concern) Doug and 69 -- thanks.

Douglas J. Steele said:

Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

Tom Wickerath MDB said:

wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

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

Click to expand...

Click to expand...

Doctorjones_md · May 30, 2007

While I appreciate your willingness to impart knowledge (or best practices),
your guidance/input lacks the finesse of someone whose main goal is to be
heard. My advice to parents has always been not to yield to the screaming
child, but to guide them back to productive communication.

I offer this this advice, not to infuriate, but to motivate. Have a
Fanatical Day!

Tom Wimpernark said:
Doc

just because these people slander me; it doesn't make me wrong.

Anyone using MDB in the year 2007 should be fired and then spit upon.
It is the equivalent of using LEECHES in the medical field

Doctorjones_md said:

I appreciate the explanation (and concern) Doug and 69 -- thanks.

Douglas J. Steele said:

Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

wtf, why would you link to SQL Server

you should be using Access Data Projects
and you should be using REPORTS isntead of word

how did you make it through medical school?

have yuo always been this much of a dumbfuck?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything

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

Click to expand...

Click to expand...

Marshall Barton · May 30, 2007

Please trim this thread to a reasonable length when replying
so as to avoid placing an undue burden on everyone. Not
only is each post going from redundantly lenghty to
ridiculously long, but it is unnecessarily crossposted to
EIGHT newsgroups.

Making a macro only work on certain files	2	Nov 11, 2022
Copy Data From an ACCESS form to a Text From Field in a WORD Template	15	May 4, 2007
Word macro that can call cells out of Excel for a find and replace	0	Dec 7, 2022
Code to fill Word form for multiple records from Access	4	Mar 16, 2010
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser)	0	Oct 24, 2022
Macro to Select text from a point given to a specific word	2	Mar 7, 2022
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel	0	Dec 21, 2021
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key	0	Feb 3, 2023

Copy Data From an ACCESS form to a WORD Template

Doctorjones_md

Pat Hartman \(MVP\)

Doctorjones_md

Guest

Guest

Pat Hartman \(MVP\)

Doctorjones_md

Pat Hartman \(MVP\)

Doctorjones_md

Tom Wickerath MDB

'69 Camaro

Douglas J. Steele

Doctorjones_md

Tom Wimpernark

Doctorjones_md

Marshall Barton

Ask a Question

Similar Threads