Help with ADO script

[newbieone]

I have three tables I need to compare and if differnt then update. Table1 compares to table2 if differnt then update and it works. Table1 compare to table3 and I get nothing. Any ideas

 

[Golom]

Not without seeing the code you are using. When you are "comparing" tables, exactly what are you comparing?

One field? The key fields? All fields? Some derived quantity?

 

[newbieone]

comparing primary keys.

here's the code that works. the second if statement based on this one does not work. What I'm I missing?
If rstbl1.RecordCount > rstbl2.RecordCount Then
Set rsinsert = New ADODB.Recordset
rsinsert.Open strsql2, adConn, adOpenKeyset, adLockOptimistic
With rsinsert
.MoveFirst
Do Until .EOF
rstbl2.AddNew
rstbl2.Fields("TrainingID") = .Fields("ContactID")
rstbl2.Fields("FirstNameT") = .Fields("FirstName")
rstbl2.Fields("LastNameT") = .Fields("LastName")
rstbl2.Update
.MoveNext
Loop
End With
rsinsert.Close
rstbl1.Close
rstbl2.Close
Set rsinsert = Nothing
Set rstbl1 = Nothing
Set rstbl2 = Nothing
Else
rstbl1.Close
rstbl2.Close
Set rstbl1 = Nothing
Set rstbl2 = Nothing
End If

 

[Golom]

Can't be sure since I can't see the SQL behind rstbl1, rstbl2 or rsinsert but if you are getting nothing happening then it must be that

rstbl1.RecordCount <= rstbl2.RecordCount​

OR that the attempts to add records are failing because of some integrity constraint such as duplicate key fields.

You may also note that the RecordCount property is usually not accurate unless you have fully populated the recordset by doing a "MoveLast" or otherwise navigated to the end of the recordset.

 

[newbieone]

I am enclosing all the code in this procedure, please let me know what you think, I really need to get this working.

as you will see the first part of the code works fine. The second if statement is what is causing the issue.

Private Sub cmdCloseApp_Click()
On Error GoTo Err_cmdCloseApp_Click

Dim adConn As ADODB.Connection
Dim rstbl1 As ADODB.Recordset
Dim rstbl2 As ADODB.Recordset
Dim rstbl3 As ADODB.Recordset
Dim rsinsert As ADODB.Recordset
Dim strsql, strsql1, strsql2, strsql3, strsql4 As String

Set adConn = New ADODB.Connection
adConn.Open CurrentProject.Connection

strsql = "SELECT Contactstbl.*FROM Contactstbl WITH OWNERACCESS OPTION;"
strsql1 = "SELECT Trainingtbl.*FROM Trainingtbl WITH OWNERACCESS OPTION"
strsql2 = "SELECT Contactstbl.*, Trainingtbl.TrainingID FROM Contactstbl LEFT JOIN Trainingtbl ON Contactstbl.ContactID = Trainingtbl.TrainingID WHERE (((Trainingtbl.TrainingID) Is Null))WITH OWNERACCESS OPTION;"
strsql3 = "SELECT Accreditationtbl.*FROM Accreditationtbl WITH OWNERACCESS OPTION;"
strsql4 = "SELECT Contactstbl.*, Accreditationtbl.AccreditationID FROM Contactstbl LEFT JOIN Accreditationtbl ON Contactstbl.ContactID = Accreditationtbl.AccreditationID WHERE (((Accreditationtbl.AccreditationID) Is Null))WITH OWNERACCESS OPTION;"




Set rstbl1 = New ADODB.Recordset
rstbl1.Open strsql, adConn, adOpenKeyset, adLockOptimistic
Set rstbl2 = New ADODB.Recordset
rstbl2.Open strsql1, adConn, adOpenKeyset, adLockOptimistic
Set rstbl3 = New ADODB.Recordset
rstbl3.Open strsql, adConn, adOpenKeyset, adLockOptimistic


If rstbl1.RecordCount > rstbl2.RecordCount Then
Set rsinsert = New ADODB.Recordset
rsinsert.Open strsql2, adConn, adOpenKeyset, adLockOptimistic
With rsinsert
.MoveFirst
Do Until .EOF
rstbl2.AddNew
rstbl2.Fields("TrainingID") = .Fields("ContactID")
rstbl2.Fields("FirstNameT") = .Fields("FirstName")
rstbl2.Fields("LastNameT") = .Fields("LastName")
rstbl2.Update
.MoveNext
Loop
End With
rsinsert.Close
rstbl1.Close
rstbl2.Close
Set rsinsert = Nothing
Set rstbl1 = Nothing
Set rstbl2 = Nothing
Else
rstbl1.Close
rstbl2.Close
Set rstbl1 = Nothing
Set rstbl2 = Nothing
End If



If rstbl1.RecordCount > rstbl3.RecordCount Then
Set rsinsert = New ADODB.Recordset
rsinsert.Open strsql4, adConn, adOpenKeyset, adLockOptimistic
With rsinsert
.MoveFirst
Do Until .EOF
rstbl3.AddNew
rstbl3.Fields("AccreditationID") = .Fields("ContactID")
rstbl3.Fields("FirstNameA") = .Fields("FirstName")
rstbl3.Fields("LastNameA") = .Fields("LastName")
rstbl3.Update
.MoveNext
Loop
End With
rsinsert.Close
rstbl1.Close
rstbl3.Close
Set rsinsert = Nothing
Set rstbl1 = Nothing
Set rstbl3 = Nothing
Else
rstbl1.Close
rstbl3.Close
Set rstbl1 = Nothing
Set rstbl3 = Nothing
End If



'DoCmd.Quit

Exit_cmdCloseApp_Click:
Exit Sub

Err_cmdCloseApp_Click:
MsgBox Err.Description
Resume Exit_cmdCloseApp_Click

End Sub

 

[Golom]

Looks like you could simplify this somewhat

Private Sub cmdCloseApp_Click()
On Error GoTo Err_cmdCloseApp_Click

Dim adConn                      As ADODB.Connection
Dim strsql1                     As String
Dim strsql2                     As String
Dim nRecordsTraining            As Long
Dim nRecordsAccreditation       As Long

Set adConn = New ADODB.Connection
adConn.Open CurrentProject.Connection

strsql1 = "INSERT INTO Trainingtbl (TrainingID, FirstName, LastName) " & _
          "Select ContactID, FirstName, LastName " & _
          "From Contactstbl C LEFT JOIN Trainingtbl T " & _
          "     ON C.ContactID = T.TrainingID " & _
          "Where T.TrainingID IS NULL;"

strsql2 = "INSERT INTO Accreditationtbl (AccreditationID, FirstName, LastName) " & _
          "Select ContactID, FirstName, LastName " & _
          "From Contactstbl C LEFT JOIN Accreditationtbl A " & _
          "     ON C.ContactID = A.AccreditationID " & _
          "Where A.AccreditationID IS NULL;"

adConn.Execute strsql1, nRecordsTraining
adConn.Execute strsql2, nRecordsAccreditation

MsgBox nRecordsTraining & " records Added to Training" & vbCrLf & _
       nRecordsAccreditation & " records Added to Accreditation", _
       vbInformation, "Additions Complete"
       
Exit_cmdCloseApp_Click:
Set adConn = Nothing
Exit Sub

Err_cmdCloseApp_Click:
MsgBox Err.Description
Resume Exit_cmdCloseApp_Click

End Sub