Access Mail Merge to Word.doc files ?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

The following code works to print select records from DB2 table
(Prtno_Num=20) to various output reports based on RESULT_CDE values and
prints it's specific report. Is there some way to revert to sending this
record to Microsoft Word and merge the data into word.doc formatted formal
letters. If so, could someone provide guidance, the database side of access
is needed to select the records for print, while the user wants to be able to
spool the print to word documents, view, and possibly modify resulting
letters, then print all in one multiple page document. Any clues if this
could be converted and accomplished?

Thanks,

Robert

Option Compare Database
'The form is used by the Legal System / Financial Responsibilites
Application. It
'is used as a Application Menu that allows the user to select the type
of Report Run
'to be requested: Hearing Letters, Cancellation Letters, or Findings
Letters.
'The code was last revised: 05/09/2005
'Developed on Microsoft Access 2003 Professional By Robert E. Nusz
'Application Support, Department of Public Safety, State of Oklahoma

Private Sub Combo13_Click()

Dim intThisRun As Integer 'used to identify type of run, 10, 13, 20
Dim strSQL As String 'used to hold SQL string for Alter Table
command
Dim strResultCde As String

If Combo13 = 10 Then
MsgBox " Now creating Hearing Letters ! "
DoCmd.runMacro "FRM-CR10RW"
strSQL = "ALTER TABLE DPS_FRQ_CR10RW " & _
"ADD CONSTRAINT PK_CR10RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
'MsgBox " Result Code Is " & RESULT_CDE
intThisRun = 10
'MsgBox " This run is a type " & intThisRun
ElseIf Combo13 = 13 Then
MsgBox " Now Creating Cancellation Letters ! "
DoCmd.runMacro "FRM-CR13RW"
strSQL = "ALTER TABLE DPS_FRQ_CR13RW " & _
"ADD CONSTRAINT PK_CR13RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
intThisRun = 13
'MsgBox " This run is a type " & intThisRun
ElseIf Combo13 = 20 Then
MsgBox " Now Creating Finding Letters ! "
DoCmd.runMacro "FRM-CR20RW"
strSQL = "ALTER TABLE DPS_FRQ_CR20RW " & _
"ADD CONSTRAINT PK_CR20RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
intThisRun = 20
'MsgBox " This run is a type " & intThisRun
Else
MsgBox " Value Entered To Combo13 Field Was Invalid, Try Again ! "
End If

Select Case intThisRun
Case 10
' CHECK TO SEE IF THE USER WANTS TO PRINT CASE HEARING LETTERS
NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Hearing Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHHearings", acViewNormal
MsgBox " Now Printing Case Hearing Letters "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT FOLDER LABELS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Folder Labels Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Folder Label Forms " & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-FolderLabel", acViewNormal
MsgBox " Now Printing Case Folder Labels "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT A NEW ALPHA-LIST
REPORT NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "A New
Alpha-List Report", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Plain Paper Forms " & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-Alpha-List", acViewNormal
MsgBox " Now Printing Alpha-List Report "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT A NEW DOCKET-LIST
REPORT NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "A New
Docket List Report", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox("Are Plain Paper Forms" & Chr$(10) &
"Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-Docket", acviewNormal
MsgBox "Now Printing New Docket List"
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT NEW INFO-SHEETS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "New F.R.
Info Sheets Now", _
vbQuestion + vbYesNo)
If Returnal = 6 Then
Returnval = MsgBox("Are Plain Paper Forms" & Chr$(10) &
"Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-InfoSheet", acviewNormal
MsgBox "Now Printing New Info Sheets"
End If
End If

Case 13
' CHECK TO SEE IF THE USER WANTS TO PRINT CASE CANCELLATION
LETTERS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Cancellation Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHCancellations",
acViewNormal
MsgBox " Now Printing Case Cancellation Letters "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If
Case 20

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE FINDINGS LETTERS
NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Findings Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHFindings", acViewNormal
MsgBox " Now Printing Case Hearing Letters "
ReadInTable
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If

Case Else
MsgBox " No Letters Selected ! ", vbExclamation
End Select
Exit Sub

End Sub

Private Sub Command9_Return_Click()
On Error GoTo Err_Command9_Return_Click
'When clicked, this button will redirect the user back to form
FRF-Main-Menu

DoCmd.Close

Exit_Command9_Return_Click:
Exit Sub

Err_Command9_Return_Click:
MsgBox Err.Description
Resume Exit_Command9_Return_Click

End Sub

Function ReadInTable()
Dim rstResultCode As ADODB.Recordset
Set rstResultCode = New ADODB.Recordset
'Establish the connection, cursor type, and open the recordset
rstResultCode.ActiveConnection = CurrentProject.Connection
rstResultCode.CursorType = adOpenForwardOnly
rstResultCode.Open "Select * from DPS_FRQ_CR20RW"
'Print Proper Finding Letter Based on RESULT_CDE Value
'Loop through until EOF
Dim curCaseNumYr As Integer
Dim curCaseNum As Integer
Dim strCriteria As String
Dim strReportName As String

If Not rstResultCode.BOF Then
rstResultCode.MoveFirst
Do Until rstResultCode.EOF
'MsgBox " rstResultCode.BOF = " & rstResultCode.BOF
'MsgBox " rstResultCode.EOF = " & rstResultCode.EOF
If rstResultCode![RESULT_CDE] = "11" Then
strReportName = "FRR-FOFRC11"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC11 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "12" Then
strReportName = "FRR-FOFRC12"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC12 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "14" Then
strReportName = "FRR-FOFRC14"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC14 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "15" Then
strReportName = "FRR-FOFRC15"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC15 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "16" And
rstResultCode![SECURITY_AMT] > 0 Then
strReportName = "FRR-FOFRC16$"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC16$ 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "16" And
IsNull(rstResultCode![SECURITY_AMT]) Then
strReportName = "FRR-FOFRC16N$"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC16N$ 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "17" Then
strReportName = "FRR-FOFRC17"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC17 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "18" Then
strReportName = "FRR-FOFRC18"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC18 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "21" Then
strReportName = "FRR-FOFRC21"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC21 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "22" Then
strReportName = "FRR-FOFRC22"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC22 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "23" Then
strReportName = "FRR-FOFRC23"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC23 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "24" Then
strReportName = "FRR-FOFRC24"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC24 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "25" Then
strReportName = "FRR-FOFRC25"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC25 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "26" And
rstResultCode![SECURITY_AMT] > 0 Then
strReportName = "FRR-FOFRC26$"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC26$ 1 Copy
ElseIf rstResultCode![RESULT_CDE] = "26" And
IsNull(rstResultCode![SECURITY_AMT]) Then
strReportName = "FRR-FOFRC26N$"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC26N$ 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "27" Then
strReportName = "FRR-FOFRC27"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC27 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "28" Then
strReportName = "FRR-FOFRC28"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC28 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "29" Then
strReportName = "FRR-FOFRC29"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC29 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "31" Then
strReportName = "FRR-FOFRC31"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC31 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "32" Then
strReportName = "FRR-FOFRC32"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC32 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "34" Then
strReportName = "FRR-FOFRC34"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC34 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "35" Then
strReportName = "FRR-FOFRC35"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC35 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "37" Then
strReportName = "FRR-FOFRC37"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC37 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "41" Then
strReportName = "FRR-FOFRC41"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC41 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "42" Then
strReportName = "FRR-FOFRC42"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC42 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "44" Then
strReportName = "FRR-FOFRC44"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC44 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "45" Then
strReportName = "FRR-FOFRC45"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC45 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "47" Then
strReportName = "FRR-FOFRC47"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC47 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] > "49" And _
rstResultCode![RESULT_CDE] < "60" Then
MsgBox " Like 5xxx " & rstResultCode![RESULT_CDE]
strReportName = "FRR-FOFRC5x"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
MsgBox " Printing 5xxx " & rstResultCode![RESULT_CDE]
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
Else
MsgBox " Invalid Result Code Found In Followng Record"
Dim strBadRecordKey As String
strBadRecordKey = rstResultCode![CASE_NUM_YR] & " " &
rstResultCode![CASE_NUM] & " " & rstResultCode![RESULT_CDE]
MsgBox strBadRecordKey
End If
rstResultCode.MoveNext
Loop
End If
rstResultCode.Close
Set rstResultCode = Nothing
End Function
 
I'm not sure if I understand this completely, but my first thought is to set
up a query in Access, then do a MailMerge document in Word that pulls the
information from the query.

Bruce

RNUSZ@OKDPS said:
The following code works to print select records from DB2 table
(Prtno_Num=20) to various output reports based on RESULT_CDE values and
prints it's specific report. Is there some way to revert to sending this
record to Microsoft Word and merge the data into word.doc formatted formal
letters. If so, could someone provide guidance, the database side of access
is needed to select the records for print, while the user wants to be able to
spool the print to word documents, view, and possibly modify resulting
letters, then print all in one multiple page document. Any clues if this
could be converted and accomplished?

Thanks,

Robert

Option Compare Database
'The form is used by the Legal System / Financial Responsibilites
Application. It
'is used as a Application Menu that allows the user to select the type
of Report Run
'to be requested: Hearing Letters, Cancellation Letters, or Findings
Letters.
'The code was last revised: 05/09/2005
'Developed on Microsoft Access 2003 Professional By Robert E. Nusz
'Application Support, Department of Public Safety, State of Oklahoma

Private Sub Combo13_Click()

Dim intThisRun As Integer 'used to identify type of run, 10, 13, 20
Dim strSQL As String 'used to hold SQL string for Alter Table
command
Dim strResultCde As String

If Combo13 = 10 Then
MsgBox " Now creating Hearing Letters ! "
DoCmd.runMacro "FRM-CR10RW"
strSQL = "ALTER TABLE DPS_FRQ_CR10RW " & _
"ADD CONSTRAINT PK_CR10RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
'MsgBox " Result Code Is " & RESULT_CDE
intThisRun = 10
'MsgBox " This run is a type " & intThisRun
ElseIf Combo13 = 13 Then
MsgBox " Now Creating Cancellation Letters ! "
DoCmd.runMacro "FRM-CR13RW"
strSQL = "ALTER TABLE DPS_FRQ_CR13RW " & _
"ADD CONSTRAINT PK_CR13RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
intThisRun = 13
'MsgBox " This run is a type " & intThisRun
ElseIf Combo13 = 20 Then
MsgBox " Now Creating Finding Letters ! "
DoCmd.runMacro "FRM-CR20RW"
strSQL = "ALTER TABLE DPS_FRQ_CR20RW " & _
"ADD CONSTRAINT PK_CR20RW " & _
"PRIMARY KEY(Case_Num_Yr,Case_Num)"
CurrentDb.Execute strSQL, dbFailOnError
intThisRun = 20
'MsgBox " This run is a type " & intThisRun
Else
MsgBox " Value Entered To Combo13 Field Was Invalid, Try Again ! "
End If

Select Case intThisRun
Case 10
' CHECK TO SEE IF THE USER WANTS TO PRINT CASE HEARING LETTERS
NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Hearing Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHHearings", acViewNormal
MsgBox " Now Printing Case Hearing Letters "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT FOLDER LABELS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Folder Labels Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Folder Label Forms " & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-FolderLabel", acViewNormal
MsgBox " Now Printing Case Folder Labels "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT A NEW ALPHA-LIST
REPORT NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "A New
Alpha-List Report", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Plain Paper Forms " & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-Alpha-List", acViewNormal
MsgBox " Now Printing Alpha-List Report "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT A NEW DOCKET-LIST
REPORT NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "A New
Docket List Report", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox("Are Plain Paper Forms" & Chr$(10) &
"Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-Docket", acviewNormal
MsgBox "Now Printing New Docket List"
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT NEW INFO-SHEETS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "New F.R.
Info Sheets Now", _
vbQuestion + vbYesNo)
If Returnal = 6 Then
Returnval = MsgBox("Are Plain Paper Forms" & Chr$(10) &
"Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-InfoSheet", acviewNormal
MsgBox "Now Printing New Info Sheets"
End If
End If

Case 13
' CHECK TO SEE IF THE USER WANTS TO PRINT CASE CANCELLATION
LETTERS NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Cancellation Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHCancellations",
acViewNormal
MsgBox " Now Printing Case Cancellation Letters "
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If
Case 20

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE FINDINGS LETTERS
NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Findings Letters Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Legal Letterhead Forms" & Chr$(10)
& " Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseLHFindings", acViewNormal
MsgBox " Now Printing Case Hearing Letters "
ReadInTable
End If
End If

' CHECK TO SEE IF THE USER WANTS TO PRINT CASE EVELOPES NOW!
Returnval = MsgBox("Do You Wish To Print" & Chr$(10) & "Case
Envelopes Now", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
Returnval = MsgBox(" Are Envelope Forms" & Chr$(10) & "
Currently In Printer", _
vbQuestion + vbYesNo)
If Returnval = 6 Then
'DoCmd.OpenReport "FRR-CaseEnvelope", acViewNormal
MsgBox " Now Printing Case Envelopes "
End If
End If

Case Else
MsgBox " No Letters Selected ! ", vbExclamation
End Select
Exit Sub

End Sub

Private Sub Command9_Return_Click()
On Error GoTo Err_Command9_Return_Click
'When clicked, this button will redirect the user back to form
FRF-Main-Menu

DoCmd.Close

Exit_Command9_Return_Click:
Exit Sub

Err_Command9_Return_Click:
MsgBox Err.Description
Resume Exit_Command9_Return_Click

End Sub

Function ReadInTable()
Dim rstResultCode As ADODB.Recordset
Set rstResultCode = New ADODB.Recordset
'Establish the connection, cursor type, and open the recordset
rstResultCode.ActiveConnection = CurrentProject.Connection
rstResultCode.CursorType = adOpenForwardOnly
rstResultCode.Open "Select * from DPS_FRQ_CR20RW"
'Print Proper Finding Letter Based on RESULT_CDE Value
'Loop through until EOF
Dim curCaseNumYr As Integer
Dim curCaseNum As Integer
Dim strCriteria As String
Dim strReportName As String

If Not rstResultCode.BOF Then
rstResultCode.MoveFirst
Do Until rstResultCode.EOF
'MsgBox " rstResultCode.BOF = " & rstResultCode.BOF
'MsgBox " rstResultCode.EOF = " & rstResultCode.EOF
If rstResultCode![RESULT_CDE] = "11" Then
strReportName = "FRR-FOFRC11"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC11 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "12" Then
strReportName = "FRR-FOFRC12"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC12 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "14" Then
strReportName = "FRR-FOFRC14"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC14 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "15" Then
strReportName = "FRR-FOFRC15"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
" AND [FRQ-FOFPC20]![CASE_NUM] = " & curCaseNum
'Print current Record to form FRR-FOFRC15 1 Copy
DoCmd.OpenReport strReportName, acViewNormal, , strCriteria
ElseIf rstResultCode![RESULT_CDE] = "16" And
rstResultCode![SECURITY_AMT] > 0 Then
strReportName = "FRR-FOFRC16$"
curCaseNumYr = rstResultCode![CASE_NUM_YR]
curCaseNum = rstResultCode![CASE_NUM]
strCriteria = "[FRQ-FOFPC20]![CASE_NUM_YR] = " &
curCaseNumYr & _
Click to expand...
 
Back
Top