Re: Two expected records missing from SQL Server table after write

Fine. Here's the code for the relevant procedure:

Private Sub cmdFill_FlatFileTable_Click()

On Error GoTo Err_cmdFill_FlatFileTable_Click

Dim strFlatFile_TableName As String
Dim strMsg As String
Dim strSQL As String
Dim strFilterGroup As String 'if none, then "NONE"
Dim dtFillDateTime As Date
Dim strFillDateTime As String
Dim strFilterGroupAndFillDateTime As String
Dim rsMeta As Recordset 'single-record recordset containing the
individual flat-file metadata
Dim rsInd As Recordset 'the INDIVIDUAL table
Dim res As Integer
Dim varContactsRel As Variant 'the guid corresponding to the "has as a
contact" relationship
Dim varOrganization_ID As Variant

'Initialize dtFillDateTime
dtFillDateTime = #1/1/1900#

'Initialize varOrganization_ID
varOrganization_ID = Null

'Verify that a valid individual flat-file tablename has been chosen. If
not, bail out.
If Trim$(cboFlatFile_TableNames.Text) = "" Then
strMsg = "You must first select a valid individual flat-file table
name using the drop-down box to the left !"
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
Exit Sub
strFlatFile_TableName = Trim$(CStr(cboFlatFile_TableNames.Text))
End If

'Verify that user wants to go ahead.
strMsg = "You are about to fill the individual flat-file table named '"
& strFlatFile_TableName & "' " & vbCr & vbLf
strMsg = strMsg & "with current data. Any existing data in the table
will be erased."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")

If res = vbOK Then 'go ahead

'Call the MS Access form titled "Select Individual Filter Group (If
'Get the strFilterGroup return value, and close the form.
DoCmd.OpenForm "GetIndGroupName", acNormal, , , , acDialog 'The
acDialog option is REQUIRED in order for GetIndGroupName to behave like a
dialog box.
strFilterGroup = Forms!GetIndGroupName.FilterGroup() 'The
FilterGroup public function is REQUIRED in order to return the strFilterGroup
public variable.
DoCmd.Close acForm, "GetIndGroupName"

If strFilterGroup = "NONE" Then 'NO filtration by group
strMsg = "You are about to fill the individual flatfile table
''" & strFlatFile_TableName & "'' without filtering by group."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")
If res = vbCancel Then
strMsg = "The filling of the individual flatfile ''" &
strFlatFile_TableName & "'' has been canceled."
MsgBox strMsg, vbOKOnly, "Note"
Exit Sub
End If
Else 'filtration by group
strMsg = "You are about to fill the individual flatfile table
''" & strFlatFile_TableName & "'', filtering by the individual group ''" &
strFilterGroup & "''."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")
If res = vbCancel Then
strMsg = "The filling of the individual flatfile ''" &
strFlatFile_TableName & "'' has been canceled."
MsgBox strMsg, vbOKOnly, "Note"
Exit Sub
End If
End If

'Set mousepointer to the hourglass.
Screen.MousePointer = 11

'Delete all records from the selected individual flat-file table.
strSQL = "DELETE FROM " & strFlatFile_TableName
On Error Resume Next 'in case there are no records in
CurrentProject.Connection.Execute strSQL, , adCmdText +

'Get the one-record metadata for the selected strFlatFile_TableName.
Set rsMeta = New Recordset
WHERE TableName ='" & strFlatFile_TableName & "'"
rsMeta.ActiveConnection = CurrentProject.Connection
rsMeta.CursorType = adOpenForwardOnly
rsMeta.LockType = adLockOptimistic 'since we need to write the
columns DateTimeTableFilled and FilterGroupName
rsMeta.CacheSize = 1
'[Now you can just refer to rsMeta("TableName"),
rsMeta("Individual_ID") etc. to get at the metadata.]

'Open the rsFlatFile recordset to receive data.
Set rsFlatFile = New Recordset
rsFlatFile.Source = "SELECT * FROM " & strFlatFile_TableName
rsFlatFile.ActiveConnection = CurrentProject.Connection
rsFlatFile.CursorType = adOpenForwardOnly
rsFlatFile.LockType = adLockOptimistic
rsFlatFile.CacheSize = 1

'Open rsInd to read from the INDIVIDUAL table.
Set rsInd = New Recordset
If strFilterGroup = "NONE" Then 'NO filter by individual group
MiddleName, Suffix"
Else 'filter by individual group
GM.GroupName = '"
strSQL = strSQL & strFilterGroup & "' AND GM.Individual_ID =
INDIVIDUAL.Individual_ID) "
strSQL = strSQL & "ORDER BY LastName, FirstName, MiddleName,
End If
rsInd.Source = strSQL
rsInd.ActiveConnection = CurrentProject.Connection
rsInd.CursorType = adOpenForwardOnly
rsInd.LockType = adLockReadOnly
rsInd.CacheSize = 1

'If no rsInd records, bail out.

If rsInd.RecordCount = 0 Then

If strFilterGroup = "NONE" Then
strMsg = "There are no individual records to fill the
individual flatfile table with."
strMsg = "There are no individual records in the individual
group ''" & strFilterGroup & "'' to fill the individual flatfile table with."
End If

MsgBox strMsg, vbOKOnly + vbCritical, "Stop"

dtFillDateTime = #1/1/1900#
strFilterGroup = "EMPTY"

GoTo Exit_cmdFill_FlatFileTable_Click

End If

'Go through rsInd (INDIVIDUAL), creating the rsFlatFile records as
you go.


Do Until rsInd.EOF

rsFlatFile.AddNew 'create new individual flat-file record

If rsMeta("Individual_ID") = True Then
rsFlatFile("Individual_ID") = rsInd("Individual_ID")
End If

If rsMeta("Salutation") = True Then
rsFlatFile("Salutation") = rsInd("Salutation")
End If

If rsMeta("FirstName") = True Then
rsFlatFile("FirstName") = rsInd("FirstName")
End If

If rsMeta("MiddleName") = True Then
rsFlatFile("MiddleName") = rsInd("MiddleName")
End If

If rsMeta("LastName") = True Then
rsFlatFile("LastName") = rsInd("LastName")
End If

If rsMeta("Suffix") = True Then
rsFlatFile("Suffix") = rsInd("Suffix")
End If

If rsMeta("Nickname") = True Then
rsFlatFile("Nickname") = rsInd("Nickname")
End If

If rsMeta("Title") = True Then
rsFlatFile("Title") = rsInd("Title")
End If

If rsMeta("Gender") = True Then
rsFlatFile("Gender") = rsInd("Gender")
End If

If rsMeta("BirthDate") = True Then
rsFlatFile("BirthDate") = rsInd("BirthDate")
End If

If rsMeta("SocialSecurityNumber") = True Then
rsFlatFile("SocialSecurityNumber") =
End If

If rsMeta("IndividualUserID") = True Then
rsFlatFile("IndividualUserID") = rsInd("IndividualUserID")
End If

If rsMeta("SpouseName") = True Then
rsFlatFile("SpouseName") = rsInd("SpouseName")
End If

If rsMeta("ChildrenNames") = True Then
rsFlatFile("ChildrenNames") = rsInd("ChildrenNames")
End If

If rsMeta("Notes") = True Then
rsFlatFile("Notes") = rsInd("Notes")
End If

If rsMeta("PhotoPath") = True Then
rsFlatFile("PhotoPath") = rsInd("PhotoPath")
End If

If rsMeta("UserID") = True Then
rsFlatFile("UserID") = rsInd("UserID")
End If

If rsMeta("DateTimeAdded") = True Then
rsFlatFile("DateTimeAdded") = rsInd("DateTimeAdded")
End If

If rsMeta("QB_Customer_ListID") = True Then
rsFlatFile("QB_Customer_ListID") = rsInd("QB_Customer_ListID")
End If

If rsMeta("QB_Vendor_ListID") = True Then
rsFlatFile("QB_Vendor_ListID") = rsInd("QB_Vendor_ListID")
End If

If rsMeta("QB_Employee_ListID") = True Then
rsFlatFile("QB_Employee_ListID") = rsInd("QB_Employee_ListID")
End If

If rsMeta("QB_Balance") = True Then
rsFlatFile("QB_Balance") = rsInd("QB_Balance")
End If

If rsMeta("Degrees") = True Then
Call Do_Degrees(rsInd("Individual_ID"),
End If

If rsMeta("EmailAddresses") = True Then
Call Do_EmailAddresses(rsInd("Individual_ID"),
End If

If rsMeta("TypeNoneAddresses") = True Then
Call Do_TypeNoneAddresses(rsInd("Individual_ID"),
End If

If rsMeta("BillingAddresses") = True Then
Call Do_BillingAddresses(rsInd("Individual_ID"),
End If

If rsMeta("ShippingAddresses") = True Then
Call Do_ShippingAddresses(rsInd("Individual_ID"),
End If

If rsMeta("FaxPhones") = True Then
Call Do_FaxPhones(rsInd("Individual_ID"),
End If

If rsMeta("MobilePhones") = True Then
Call Do_MobilePhones(rsInd("Individual_ID"),
End If

If rsMeta("PagerPhones") = True Then
Call Do_PagerPhones(rsInd("Individual_ID"),
End If

If rsMeta("TollFreePhones") = True Then
Call Do_TollFreePhones(rsInd("Individual_ID"),
End If

If rsMeta("VoicePhones") = True Then
Call Do_VoicePhones(rsInd("Individual_ID"),
End If

If rsMeta("Groups") = True Then
Call Do_Groups(rsInd("Individual_ID"), rsMeta("MaxNumGroups"))
End If

If rsMeta("OrganizationName_ContactFor") = True Then
varContactsRel = DGuidLookup("Org2Ind_Rel_ID",
"ORG_TO_IND_RELATIONSHIP", "Org2Ind_Relationship", "has as a contact")
Call Do_OrganizationName(rsInd("Individual_ID"),
varContactsRel, varOrganization_ID)
End If

If rsMeta("OrganizationAddress_ContactFor") = True And Not
IsNull(varOrganization_ID) Then
End If

rsFlatFile.Update 'update new individual flat-file record

rsInd.MoveNext 'move to next INDIVIDUAL record


'Update dtFillDateTime
dtFillDateTime = Now

'Inform user of success.

MsgBox "The '" & strFlatFile_TableName & "' table has been filled
with current data.", vbOKOnly, "Note"

End If


'Write the columns DateTimeTableFilled and FilterGroupName
rsMeta("DateTimeTableFilled") = dtFillDateTime
rsMeta("FilterGroupName") = strFilterGroup

'Update label for cboFlatFile_TableNames

'Build strFilterGroupAndFillDateTime
strFillDateTime = CStr(dtFillDateTime)
strFilterGroupAndFillDateTime = "Filter Group = " & strFilterGroup &
vbCrLf & "Fill Date/Time = " & strFillDateTime

'Load the caption.
Me![lblFilterGroupAndFillDateTime].Caption =

'Close open recordsets, if necessary.

If Not rsMeta Is Nothing Then
If rsMeta.State <> adStateClosed Then
End If
Set rsMeta = Nothing
End If

If Not rsFlatFile Is Nothing Then
If rsFlatFile.State <> adStateClosed Then
End If
Set rsFlatFile = Nothing
End If

If Not rsInd Is Nothing Then
If rsInd.State <> adStateClosed Then
End If
Set rsInd = Nothing
End If

'Re-set mousepointer to the default.
Screen.MousePointer = 0

'Exit Sub
Exit Sub


MsgBox Err.Description
Resume Exit_cmdFill_FlatFileTable_Click

End Sub

"Sylvain Lafontaine" wrote:

My first thought would be to make sure that there is no duplicate in the
first record.

My second thought is wondering how do you think we may help you without
having any details on the piece of VBA code doing this little piece of

Sylvain Lafontaine, ing.
MVP - Technologies Virtual-PC

"PhilEngle" <PhilEngle@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
I have a Microsoft Access ADP that goes against an MS SQL Server 2000

Within this MS Access ADP I have a recordset (forward only, read only,
cachesize 1) that is the result of a SELECT. . .WHERE EXISTS query. This
recordset is gone through to create corresponding records (1-for-1) in
another recordset which is open for write (forward only, optimistic
cachesize 1) to an empty SQL Server 2000 table.

This works fine if the first recordset returns 5 or fewer records.
if the first recordset returns 6 or more records, then the actual number
records that appear in the SQL Server 2000 table are short by 2: In other
words, if 6 records are expected I only get 4, if 7 records are expected I
only get 5, etc. !

Debugging shows that the RecordCount is correct, that AddNew is executed
correct number of times, and that Update is executed the correct number of
times. Yet, when I look over at the resulting table using Enterprise
it's 2 records short!

There's nothing wrong with the WHERE EXISTS query either: It works
in other contexts. Also, CacheSize has nothing to do with the problem: In
addition to the original value of 1 I tried -1, 20, and 100.

Any ideas? Any help you could give would be greatly appreciated!


Relevant Pages