Option Compare Database



Sub bankdaten_migration()

Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim MGNR As Long
Dim KontoNr As String
Dim BLZ As String
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("TMitglieder")

db1.Execute ("UPDATE RTRN6730000000000001 Set Übernommen=False")
While Not rs1.EOF
 MGNR = rs1("MGNR")
 If Not IsNull(rs1("KontoNr")) And Not IsNull(rs1("BLZ")) Then
    KontoNr = rs1("Kontonr")
    KontoNr = Replace(KontoNr, ".", "")
    KontoNr = Replace(KontoNr, "-", "")
    KontoNr = Replace(KontoNr, " ", "")
    BLZ = rs1("BLZ")
    While Left(KontoNr, 1) = "0"
     KontoNr = Mid(KontoNr, 2)
    Wend
    
    Set rs2 = db1.OpenRecordset("SELECT * FROM RTRN6730000000000001 WHERE BLZ='" + BLZ + "' AND KontoNummer='" + KontoNr + "'")
    If Not rs2.EOF Then
     rs1.Edit
     rs1("IBAN") = rs2("IBAN")
     rs1("BIC") = rs2("BIC")
     rs1.Update
     rs2.Edit
     rs2("Übernommen") = True
     rs2.Update
    End If
 End If
 rs1.MoveNext
Wend
rs1.Close


End Sub