Copy Data From an ACCESS form to a WORD Template

D

Doctorjones_md

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

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

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

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



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

Dim path As String

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

Const DOC_NAME1 As String = _

"Products1.dot"

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

Const DOC_NAME2 As String = _

" Products2.dot "

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

Const DOC_NAME3 As String = _

" Products3.dot "

Private Sub AddPicture_Click()

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

' as an employee picture.

getFileName

End Sub

Private Sub cmdPrint Products1_Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

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

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME1)

If Err = 0 Then

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

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

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



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

Set rst = New ADODB.Recordset



strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

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

rst.Close

End If



With doc

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

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

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

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

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

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

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

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

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

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



End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub



Private Sub cmdPrintProducts2 _Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

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

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME2)

If Err = 0 Then

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

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

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



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

Set rst = New ADODB.Recordset



strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

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

rst.Close

End If



With doc

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

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

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

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

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

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

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

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

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

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

End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub





Private Sub cmdPrintProducts3_Click()

Dim appWord As Word.Application

Dim doc As Word.Document

Dim rst As ADODB.Recordset

Dim strSQL As String

Dim strReportsTo As String



On Error Resume Next

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

If Err = 429 Then

Set appWord = New Word.Application

Err = 0

End If



With appWord

Set doc = .Documents(DOC_NAME3)

If Err = 0 Then

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

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

.Dialogs(wdDialogFileSaveAs).Show

End If

doc.Close False

End If



On Error GoTo ErrorHandler



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

Set rst = New ADODB.Recordset





strSQL = "SELECT * FROM PRODUCTS"

rst.Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly

If Not rst.EOF Then

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

rst.Close

End If



With doc

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

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

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

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

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

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

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

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

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

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

End With

.Visible = True

.Activate

End With



Set rst = Nothing

Set doc = Nothing

Set appWord = Nothing

Exit Sub



ErrorHandler:

MsgBox Err & Err.Description

End Sub

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

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

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



Private Sub Form_RecordExit(Cancel As Integer)

' Hide the errormsg label to reduce flashing when navigating

' between records.

errormsg.Visible = False

End Sub

Private Sub RemovePicture_Click()

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

' errormsg label.

Me![ImagePath] = ""

hideImageFrame

errormsg.Visible = True

End Sub



Private Sub Form_AfterUpdate()

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

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

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

' exists.

'Me!ReportsTo.Requery

On Error Resume Next

showErrorMessage

showImageFrame

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

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

Else

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

End If

End Sub



Private Sub ImagePath_AfterUpdate()

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

On Error Resume Next

showErrorMessage

showImageFrame

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

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

Else

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

End If

End Sub

Private Sub Form_Current()

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

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

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

' appropriate message.

Dim res As Boolean

Dim fName As String



path = CurrentProject.path

On Error Resume Next

errormsg.Visible = False

If Not IsNull(Me!Photo) Then

res = IsRelative(Me!Photo)

fName = Me![ImagePath]

If (res = True) Then

fName = path & "\" & fName

End If



Me![ImageFrame].Picture = fName

showImageFrame

Me.PaintPalette = Me![ImageFrame].ObjectPalette

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

hideImageFrame

errormsg.Caption = "Picture not found"

errormsg.Visible = True

End If

Else

hideImageFrame

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

errormsg.Visible = True

End If



End Sub



Sub getFileName()

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

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

' display it in the image control.

Dim fileName As String

Dim result As Integer

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "Select Employee Picture"

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

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

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

.FilterIndex = 3

.AllowMultiSelect = False

.InitialFileName = CurrentProject.path

result = .Show

If (result <> 0) Then

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

Me![ImagePath].Visible = True

Me![ImagePath].SetFocus

Me![ImagePath].Text = fileName

Me![FirstName].SetFocus

Me![ImagePath].Visible = False

End If

End With

End Sub



Sub showErrorMessage()

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

If Not IsNull(Me!Photo) Then

errormsg.Visible = False

Else

errormsg.Visible = True

End If

End Sub



Function IsRelative(fName As String) As Boolean

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

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

End Function



Sub hideImageFrame()

' Hide the image control

Me![ImageFrame].Visible = False

End Sub



Sub showImageFrame()

' Display the image control

Me![ImageFrame].Visible = True

End Sub
 
P

Pat Hartman \(MVP\)

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...
 
G

Guest

--
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
Click to expand...
 
G

Guest

--
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
Click to expand...
 
D

Doctorjones_md

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
============
 
P

Pat Hartman \(MVP\)

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).
 
D

Doctorjones_md

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...
Click to expand...
 
T

Tom Wickerath MDB

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...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Code to fill Word form for multiple records from Access 1
User Defined Type Not Defined 0
Moving data strings longer than 255 char. from Access form to Word 1
Move data in form field to a word doc 1
Link to Word document not working 3
Push from Access to Word; Word CheckBox Object 2
MDB path same as...CurrentProject.Path & "\test.doc" 3
HELP: active X component can't create object 1

Top