Copy Data From an ACCESS form to a WORD Template

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/ex...ributors2.html for contact
info.


"Tom Wickerath MDB" wrote in message
...
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 dumb****?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything



"Doctorjones_md" wrote in message
...
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

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

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)


"Tom Wickerath MDB" wrote in message
...
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 dumb****?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything



"Doctorjones_md" wrote in message
...
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

I appreciate the explanation (and concern) Doug and 69 -- thanks.
"Douglas J. Steele" wrote in message
...
Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)


"Tom Wickerath MDB" wrote in message
...
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 dumb****?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything



"Doctorjones_md" wrote in message
...
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

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" wrote in message
...
I appreciate the explanation (and concern) Doug and 69 -- thanks.
"Douglas J. Steele" wrote in message
...
Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)


"Tom Wickerath MDB" wrote in message
...
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 dumb****?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything



"Doctorjones_md" wrote in message
...
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

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" wrote in message
...
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" wrote in message
...
I appreciate the explanation (and concern) Doug and 69 -- thanks.
"Douglas J. Steele" wrote in message
...
Please note that this post is from Aar.on Kem.pff, a known troll.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)


"Tom Wickerath MDB" wrote in message
...
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 dumb****?

FILE, NEW, PROJECT EXISTING DATA

spit on anyone still using jet for anything



"Doctorjones_md" wrote in message
...
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

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.

--
Marsh
MVP [MS Access]

I've never paid any attention to (as you call it) "Trimming", since most ask
us to Reply to Group -- is this better? As far as the length of an entry --
shouldn't it be whatever it takes to get one's point across? I'm not sure
what burden you're referring to -- I don't usually read threads that don't
interest or pertain to me (unless what you mean to say is, "to avoid placing
an undue burden on the MVPs -- I'm assuming that folks of lesser knowledge
use these forums to learn from those who are more learned -- I apologize for
any posts which have been lengthy. At times, it is difficult to be precise
when asking for assistance, but I will try my best!
"Marshall Barton" wrote in message
...
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.

--
Marsh
MVP [MS Access]