Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1244to1248
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte Einträge vermeiden ADO

Doppelte Einträge vermeiden ADO
Fettertiger
Hallo liebe Experten,
zunächst mal ein verspätetes schönes Neues Jahr Euch allen!
Ich hoffe Ihr könnt mir wie meistens wieder helfen:
Aus einem Exceltool heraus werden per ADO Daten auf einer Tabelle ("CIC") in eine Datenbank geschrieben.
Ich muss dabei verhindern, dass es dabei in einem bestimmten Feld zu Doppeleinträgen kommt.
Jetzt habe ich schon ein paar Stunden gegoogelt und herumprobiert, bekomme es aber irgendwie nicht hin. Wie müsste ich mein macro an der mit ? versehenen Stelle ändern?
Sub Update_Records_from_Excel_in_AccessII()
Dim FilterString, Fieldstring As String
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim DB_DatasourceString As String
Dim UpdateTime As Date
Dim Last_ConflictRow, hrow As Long
Dim Conflict As Boolean
Dim DSheet As Worksheet
Dim ChangeCounter As Integer
DB_DatasourceString = "Data Source=" & Replace(GenFileSet.Range("c8").Value, _
"%USERPROFILE%" , Environ("userprofile")) & GenFileSet.Range("c9").Value & Chr(59) _
& "Jet OLEDB:Database  Password=Superpass" & Chr(59)
' connect to the Access database
Set cn = New ADODB.Connection
If LCase(Right(GenFileSet.Range("c9").Value, 3)) = "mdb" Then
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & DB_DatasourceString  'acces mdb
Else
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & DB_DatasourceString
End If
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "CIC", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 10    ' the start row in the worksheet
WriteError = False
Set DSheet = CIC
CIC.Unprotect ("Automat")
Do While Len(CIC.Range("C" & r).Formula) > 0    ' repeat until first empty cell in column C
ChangeCounter = 0
FilterString = "DB_AutoID = " & Chr(39) & CIC.Cells(r, 100).Value & Chr(39)
rs.Filter = FilterString
If rs.Fields("last_Change")  Empty Then
With rs
UpdateTime = Now
For j = 2 To 97
On Error Resume Next
Fieldstring = FieldContent(rs.Fields(tbl_col_matrix.Cells(COlRow + 3, j).  _
Value))
If Err.Number  0 Then
Fieldstring = ""
Err.Clear
End If
If Fieldstring  CIC.Cells(r, j).Value Then
If j = 93 Then
If ? 'Prüfen ob dieser Wert (CIC.Cells(r, j).Value) breits in   _
DB
MsgBox ("Duplicate Values found")
CIC.Cells(j, 7).Select
Exit Sub
End If
End If
.Fields(tbl_col_matrix.Cells(COlRow + 3, j).Value) = CIC.Cells(r, j).  _
Value
ChangeCounter = ChangeCounter + 1
Err.Clear
End If
Next j
If ChangeCounter > 0 Then
.Fields(tbl_col_matrix.Cells(COlRow + 3, 98).Value) = UpdateTime
CIC.Cells(r, 98).Value = UpdateTime
.Fields(tbl_col_matrix.Cells(COlRow + 3, 99).Value) = CIC.Cells(r, 99).  _
Value    'country
.Update    ' stores the changed record
If Err.Number  0 Then
WriteError = True
End If
End If
End With
End If
r = r + 1    ' next row
Loop
CIC.Protect
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Danke und Gruss
Theo

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Doppelte Einträge vermeiden ADO
16.01.2012 19:02:09
Josef

Hallo Theo,
evtl. solltest du schon bei der Abfrage doppelte Vermeiden (Stichwort DISTINCT), sonst z. B. so.
If IsNumeric(Application.Match(CIC.Cells(r, j), CIC.Columns(j), 0)) Then
  MsgBox ("Duplicate Values found")
  CIC.Cells(j, 7).Select
  Exit Sub
End If


« Gruß Sepp »

Anzeige
AW: Doppelte Einträge vermeiden ADO
17.01.2012 09:32:39
Fettertiger
Hallo Sepp,
ich hätte wohl etwas mehr über das Tool erzählen sollen, denn bevor das Makro überhaupt startet führe ich den Check schon in ähnlicher Form durch.
Bei dem Tool nutze ich Excel als "Eingabe - und Verarbeitungstool" für Daten die im Hintergrund auf einer ACCDB gespeichert sind. Wenn ein Nutzer Daten aus der Datenbank nach Excel einliest, bekommt er dabei auch nur die für ihn relevanten Daten nach Excel geladen.
Deshalb "erschlägt" der von Dir vorgeschlagene Check nur einen Teil der Fehler, denn der entsprechende "doppelte" Wert kann durchaus einem anderen User zugeordnet sein.
Vielen Dank fürs weitersuchen
Grüße
Theo
Anzeige
AW: Doppelte Einträge vermeiden ADO
17.01.2012 09:50:58
Josef

Hallo Theo,
und nun?
Nur du kennst den Aufbau deiner Tabelle und nur du weißt, was, wann und wo geprüft werden soll.

« Gruß Sepp »

AW: Doppelte Einträge vermeiden ADO
17.01.2012 11:39:33
Fettertiger
Hallo nochmal,
manchmal kann es dann doch ganz einfach gehen:
Ich fange jetzt einfach den Fehler beim ".Update" ab mit
If Err.Number 0 Then
If Err.Number = -2147217887 Then
MsgBox "The XYZ combination already exists" & Chr(10) & _
"Please correct!" & Chr(10) & "The database was not synced!", vbCritical, "Duplicate XYZ Combination"
CIC.Cells(r, 7).Select
With CIC.Cells(r, 7).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
MsgBox ("Unexpected error during Writing to Database" & Chr(10) & _
"Errornumber: " & Err.Number)
End If
WriteError = True
Err.Clear
End If
Damit funzt es jetzt einwandfrei!
Danke und Gruss
Theo
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige