G
Guest
I'm new to VB code, and need to read select data and write new table record.
Input table A "DPS_FRQ_RC20RW" has data in it, PRTNO_NUM field does = value
20. table B "DPS_FR_ATTORNEY" has corresponding attorney records (connected
via ATTY_NUM) field in both tables. Table D is my expected new table
records: "DPS_FR_RC20RW_NAMES20" table. For each record in Table A, there
will be a Licensee person with (Lic_FIRST_NME, LIC_MIDDLE_NME, LIC_LAST_NME,
LIC_ADDR_TXT, LIC_CITY_NME, LIC_STATE_CDE, LIC_ZIP_CDE & LIC_ZIP4CDE data)
along with DOA person (DOA_NME, DOA_ADDR_TXT, DOA_CITY_NME, DOA_STATE_CDE,
DOA_ZIP_CDE & DOA_ZIP4CDE), there will be an Attorney number which links to
table B fields : ATTY_NUM, FIRST_NME, MIDDLE_NME, LAST_NME, etc....
I need to be able to read table A record(s) sequenially, select out each
name with address information and write this info to new table for mailing
envelope table for process at later time. So, read table a once, possibly
write 2 records to table D, select from table b, correct attorney record,
write this record to table D, read next table a record, repeat process. The
following code is my first attempt, but fails to write data to table D even
though process ends without error. Any clue as to why I read records, but
fail to write records.... any help would be appreciated. I'm executing the
called procedure from further up in the program.... Table D does exist in
current db and is empty.
Thanks in advance.
Public Sub subLoad_RC20RW_NAMES20()
On Error GoTo Error_Load_RC20RW_NAMES20
' Insert code to build new names20 records here...
MsgBox " Now executing subLoad_RC20RW_NAMES20 "
Dim rsA As Recordset
Dim rsB As Recordset
Dim rsD As Recordset
Dim intSelectAtty As Integer
MsgBox " Now opening rsA "
Set rsA = CurrentDb.OpenRecordset("DPS_FRQ_RC20RW")
MsgBox " Now opening rsB "
Set rsB = CurrentDb.OpenRecordset("DPS_FR_ATTORNEY")
MsgBox " Now opening rsD "
Set rsD = CurrentDb.OpenRecordset("DPS_FR_RC20RW_NAMES20")
Dim setSeqno As Integer
setSeqno = 0
If rsA!PRTNO_NUM = 20 Then
' Check for EOF Or BOF of Table A
If Not (rsA.BOF And rsA.EOF) Then
rsA.MoveFirst
With rsD
While Not rsA.EOF
If rsA![LIC_FIRST_NME] Is Not Null Then
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " "
& _
rsA![CASE_NUM] & " " & rsA![LIC_LAST_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build
primary key pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build
primary key pt-2
![SEQNO_NUM] = setSeqno + 1
![PRTNO_NUM] = rsA![PRTNO_NUM] ' build
PRTNO_NUM
![NAME_TXT] = rsA![LIC_FIRST_NME] & " " & _
rsA![LIC_MIDDLE_NME] & " " & _
rsA![LIC_LAST_NME] & " " & _
rsA![LIC_SUBT_TXT]
![ADDR1_TXT] = rsA![LIC_ADDR_TXT]
![CITY_TXT] = rsA![LIC_CITY_NME]
![STATE_CDE] = rsA![LIC_STATE_CDE]
![ZIPCDE_TXT] = rsA![LIC_ZIP_CDE] & " " &
rsA![LIC_ZIP4_CDE]
.Update
End If
Wend
End With
End If
With rsD
If rsA![DOA_NME] Is Not Null Then
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " " & _
rsA![CASE_NUM] & " " & rsA![DOA_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build primary key
pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build primary key
pt-2
'[SEQNO_NUM] is autoincrement, no action needed
![NAME_TXT] = rsA![DOA_NME]
![ADDR1_TXT] = rsA![DOA_ADDR_TXT]
![CITY_TXT] = rsA![DOA_CITY_NME]
![STATE_CDE] = rsA![DOA_STATE_CDE]
![ZIP_CDE] = rsA![LIC_ZIP_CDE] & " " & rsA![LIC_ZIP4_CDE]
.Update
End If
End With
If rsA![ATTY_NUM] > 0 Then
'select attorney record via sql statement
intSelectAtty = rsA![ATTY_NUM]
MsgBox " Select Attorney # = " & intSelectAtty
DoCmd.runMacro "FRM-Atty-FOF-Select"
If Not (rsB.BOF And rsB.EOF) Then
rsB.MoveFirst
With rsD
While Not rsB.EOF
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " "
& _
rsA![CASE_NUM] & " " & rsB![LAST_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build pkey
pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build pkey
pt-2
'[SEQNO_NUM] is autoincrement,
![NAME_TXT] = rsB![FIRST_NME] & " " & _
rsB![MIDDLE_NME] & " " & _
rsB![LAST_NME] & " " & _
rsB![SUBTITLE_TXT]
![FIRM_NME] = rsB![FIRM_NME]
![ADDR1_TXT] = rsB![ADDR1_TXT]
![ADDR2_TXT] = rsB![ADDR2_TXT]
![CITY_TXT] = rsB![CITY_NME]
![STATE_CDE] = rsB![STATE_CDE]
![ZIP_CDE] = rsB![LIC_ZIP_CDE] & " " &
rsB![LIC_ZIP4_CDE]
.Update
rsA.MoveNext
Wend
End With
End If
End If
End If
rsA.Close
rsB.Close
rsD.Close
Set rsA = Nothing
Set rsB = Nothing
Set rsD = Nothing
Exit_Load_RC20RW_NAMES20:
' Cleanup Code
On Error Resume Next
Exit Sub
Error_Load_RC20RW_NAMES20:
Select Case Err.Number
Case 2501
' Action Cancelled by User, Ignore Error
Case Else
' Unexpected Error Encountered
MsgBox " The following error has occurred: " _
& vbNewLine & " Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
End Select
Resume Exit_Load_RC20RW_NAMES20
End Sub
Input table A "DPS_FRQ_RC20RW" has data in it, PRTNO_NUM field does = value
20. table B "DPS_FR_ATTORNEY" has corresponding attorney records (connected
via ATTY_NUM) field in both tables. Table D is my expected new table
records: "DPS_FR_RC20RW_NAMES20" table. For each record in Table A, there
will be a Licensee person with (Lic_FIRST_NME, LIC_MIDDLE_NME, LIC_LAST_NME,
LIC_ADDR_TXT, LIC_CITY_NME, LIC_STATE_CDE, LIC_ZIP_CDE & LIC_ZIP4CDE data)
along with DOA person (DOA_NME, DOA_ADDR_TXT, DOA_CITY_NME, DOA_STATE_CDE,
DOA_ZIP_CDE & DOA_ZIP4CDE), there will be an Attorney number which links to
table B fields : ATTY_NUM, FIRST_NME, MIDDLE_NME, LAST_NME, etc....
I need to be able to read table A record(s) sequenially, select out each
name with address information and write this info to new table for mailing
envelope table for process at later time. So, read table a once, possibly
write 2 records to table D, select from table b, correct attorney record,
write this record to table D, read next table a record, repeat process. The
following code is my first attempt, but fails to write data to table D even
though process ends without error. Any clue as to why I read records, but
fail to write records.... any help would be appreciated. I'm executing the
called procedure from further up in the program.... Table D does exist in
current db and is empty.
Thanks in advance.
Public Sub subLoad_RC20RW_NAMES20()
On Error GoTo Error_Load_RC20RW_NAMES20
' Insert code to build new names20 records here...
MsgBox " Now executing subLoad_RC20RW_NAMES20 "
Dim rsA As Recordset
Dim rsB As Recordset
Dim rsD As Recordset
Dim intSelectAtty As Integer
MsgBox " Now opening rsA "
Set rsA = CurrentDb.OpenRecordset("DPS_FRQ_RC20RW")
MsgBox " Now opening rsB "
Set rsB = CurrentDb.OpenRecordset("DPS_FR_ATTORNEY")
MsgBox " Now opening rsD "
Set rsD = CurrentDb.OpenRecordset("DPS_FR_RC20RW_NAMES20")
Dim setSeqno As Integer
setSeqno = 0
If rsA!PRTNO_NUM = 20 Then
' Check for EOF Or BOF of Table A
If Not (rsA.BOF And rsA.EOF) Then
rsA.MoveFirst
With rsD
While Not rsA.EOF
If rsA![LIC_FIRST_NME] Is Not Null Then
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " "
& _
rsA![CASE_NUM] & " " & rsA![LIC_LAST_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build
primary key pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build
primary key pt-2
![SEQNO_NUM] = setSeqno + 1
![PRTNO_NUM] = rsA![PRTNO_NUM] ' build
PRTNO_NUM
![NAME_TXT] = rsA![LIC_FIRST_NME] & " " & _
rsA![LIC_MIDDLE_NME] & " " & _
rsA![LIC_LAST_NME] & " " & _
rsA![LIC_SUBT_TXT]
![ADDR1_TXT] = rsA![LIC_ADDR_TXT]
![CITY_TXT] = rsA![LIC_CITY_NME]
![STATE_CDE] = rsA![LIC_STATE_CDE]
![ZIPCDE_TXT] = rsA![LIC_ZIP_CDE] & " " &
rsA![LIC_ZIP4_CDE]
.Update
End If
Wend
End With
End If
With rsD
If rsA![DOA_NME] Is Not Null Then
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " " & _
rsA![CASE_NUM] & " " & rsA![DOA_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build primary key
pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build primary key
pt-2
'[SEQNO_NUM] is autoincrement, no action needed
![NAME_TXT] = rsA![DOA_NME]
![ADDR1_TXT] = rsA![DOA_ADDR_TXT]
![CITY_TXT] = rsA![DOA_CITY_NME]
![STATE_CDE] = rsA![DOA_STATE_CDE]
![ZIP_CDE] = rsA![LIC_ZIP_CDE] & " " & rsA![LIC_ZIP4_CDE]
.Update
End If
End With
If rsA![ATTY_NUM] > 0 Then
'select attorney record via sql statement
intSelectAtty = rsA![ATTY_NUM]
MsgBox " Select Attorney # = " & intSelectAtty
DoCmd.runMacro "FRM-Atty-FOF-Select"
If Not (rsB.BOF And rsB.EOF) Then
rsB.MoveFirst
With rsD
While Not rsB.EOF
MsgBox " Adding Record = " & rsA![CASE_NUM_YR] & " "
& _
rsA![CASE_NUM] & " " & rsB![LAST_NME]
.AddNew
![CASE_NUM_YR] = rsA![CASE_NUM_YR] ' build pkey
pt-1
![CASE_NUM] = rsA![CASE_NUM] ' build pkey
pt-2
'[SEQNO_NUM] is autoincrement,
![NAME_TXT] = rsB![FIRST_NME] & " " & _
rsB![MIDDLE_NME] & " " & _
rsB![LAST_NME] & " " & _
rsB![SUBTITLE_TXT]
![FIRM_NME] = rsB![FIRM_NME]
![ADDR1_TXT] = rsB![ADDR1_TXT]
![ADDR2_TXT] = rsB![ADDR2_TXT]
![CITY_TXT] = rsB![CITY_NME]
![STATE_CDE] = rsB![STATE_CDE]
![ZIP_CDE] = rsB![LIC_ZIP_CDE] & " " &
rsB![LIC_ZIP4_CDE]
.Update
rsA.MoveNext
Wend
End With
End If
End If
End If
rsA.Close
rsB.Close
rsD.Close
Set rsA = Nothing
Set rsB = Nothing
Set rsD = Nothing
Exit_Load_RC20RW_NAMES20:
' Cleanup Code
On Error Resume Next
Exit Sub
Error_Load_RC20RW_NAMES20:
Select Case Err.Number
Case 2501
' Action Cancelled by User, Ignore Error
Case Else
' Unexpected Error Encountered
MsgBox " The following error has occurred: " _
& vbNewLine & " Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
End Select
Resume Exit_Load_RC20RW_NAMES20
End Sub