ADODB.Connection πρόβλημα

TAKHS — Thu, 23 Feb 2012 07:06:21 GMT

Παρακαλώ την βοήθειά σας.

Έχω δύο βάσεις (DATA1 και DATA2) που έχουν τον ίδιο πίνακα και φόρμα (Contacts με πεδία FirstName, LastName, telephone).

Θέλω διάφορες εγγραφές από DATA1 να τις αντιγράφω στην DATA2 με την Command45_Click().

Όταν CheckIfIdExist = False δηλαδή δεν υπάρχει η εγγραφή στην DATA2 τότε προστίθεται σωστά η εγγραφή.

Εάν όμως CheckIfIdExist = True και υπάρχει κάποια αλλαγή στην DATA1 (π.χ ΤΗΛΕΦΩΝΟ) δεν μου επιτρέπει να κάνω update στην ίδια εγγραφή γιατί θα δημιουργήσει διπλοεγγραφή.

Υπάρχει καμιά ιδέα που κάνω λάθος;

Ευχαριστώ για κάθε βοήθεια

Ο ΚΩΔΙΚΑΣ ΜΟΥ:

Private Function CheckIfIdExist(IDNumber As Long, Table As String, FieldName As String) As Boolean

'Tsekaro to Id stin basi poy tha kano add na do an iparxi gia na min kanei diplokataxorisi

On Error GoTo err

Dim cnn As New ADODB.Connection

Dim rst As New ADODB.Recordset

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=I:\DATA2.accdb;Persist Security Info=False"

rst.Open "SELECT * FROM " & Table & " WHERE " & FieldName & " = " & IDNumber, cnn, , , adCmdUnknown

If rst.Fields(0).Value = IDNumber Then

CheckIfIdExist = True

Else

CheckIfIdExist = False

End If

cnn.Close

Exit Function

err:

CheckIfIdExist = False

End Function

Private Sub Command45_Click()

On Error GoTo err

Dim cnn As New ADODB.Connection

Dim cmd As New ADODB.Command

Dim rst As New ADODB.Recordset

Dim k As Long

Dim cnn2 As New ADODB.Connection

Dim cmd2 As New ADODB.Command

Dim rst2 As New ADODB.Recordset

' kano ta connect stis basis

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\DATA1.accdb;Persist Security Info=False"

cnn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\DATA2.accdb;Persist Security Info=False"

'beginς pelatis

rst.Open "SELECT * FROM Contacts WHERE ID = " & ID, cnn, , adLockReadOnly, adCmdUnknown

rst2.Open "Contacts", cnn2, adOpenDynamic, adLockOptimistic, adCmdTable

'elexon an yparxi stin alli basi to record me to idio id an nai

'rotaei an thes na tin kaneis update

'an nai tote kanei update ta pedia

If CheckIfIdExist(ID, "Contacts", "ID") = True Then

If MsgBox("Ο πελάτης υπάρχει είδη να γίνει Update ", vbYesNo) = vbYes Then

rst2.Update

For k = 1 To rst.Fields.Count - 1

rst2.Fields(k) = rst.Fields.Item(k).Value

rst2.UpdateBatch adAffectCurrent

End If Else

rst2.AddNew

For k = 0 To rst.Fields.Count - 1

rst2.Fields(k) = rst.Fields.Item(k).Value

rst2.UpdateBatch adAffectCurrent

End If

rst2.Close

rst.Close

'end pelatis

'klisismςo sindeseon

cnn2.Close

cnn.Close

'an olapςane kala tote bgazi minima ok :)

MsgBox "OK"

Exit Sub

err:

MsgBox err.Number & vbNewLine & err.Description

End Sub

Πρώτα Βήματα - Βάσεις δεδομένων

ADODB.Connection πρόβλημα