Παρακαλώ την βοήθειά σας.
Έχω δύο βάσεις (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
Next
rst2.UpdateBatch adAffectCurrent
End If Else
rst2.AddNew
For k = 0 To rst.Fields.Count - 1
rst2.Fields(k) = rst.Fields.Item(k).Value
Next
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