Konvertieren einer CSV Datei im Batch Betrieb

@echo off & setlocal
:: Header der out.csv in Variablen einlesen 
Set /p outcsvFlds=<out.csv
FOR /F "delims=; tokens=1-25" %%a in ("%outcsvFlds%") do (  
   Set "ocF_01=%%a"  & Set "ocF_02=%%b"   & Set "ocF_03=%%c"     
   Set "ocF_04=%%d"  & Set "ocF_05=%%e"   & Set "ocF_06=%%f"     
   Set "ocF_07=%%g"  & Set "ocF_08=%%h"   & Set "ocF_09=%%i"     
   Set "ocF_10=%%j"  & Set "ocF_11=%%k"   & Set "ocF_12=%%l"  
   Set "ocF_13=%%m"  & Set "ocF_14=%%n"   & Set "ocF_15=%%o"     
   Set "ocF_16=%%p"  & Set "ocF_17=%%q"   & Set "ocF_18=%%r"     
   Set "ocF_19=%%s"  & Set "ocF_20=%%t"   & Set "ocF_21=%%u"     
   Set "ocF_22=%%v"  & Set "ocF_23=%%w"   & Set "ocF_24=%%x"     
   Set "ocF_25=%%y"    
)   

:: Header der gruppen.csv in Variablen einlesen 
:: -------- Delims ist ein TAB
Set /p grpcsvFlds=<gruppen.csv

FOR /F "delims=	 tokens=1-25" %%a in ("%grpcsvFlds%") do (  
   Set "gcF_01=%%a"  & Set "gcF_02=%%b"   & Set "gcF_03=%%c"     
   Set "gcF_04=%%d"  & Set "gcF_05=%%e"   & Set "gcF_06=%%f"     
   Set "gcF_07=%%g"  & Set "gcF_08=%%h"   & Set "gcF_09=%%i"     
   Set "gcF_10=%%j"  & Set "gcF_11=%%k"   & Set "gcF_12=%%l"  
   Set "gcF_13=%%m"  & Set "gcF_14=%%n"   & Set "gcF_15=%%o"     
   Set "gcF_16=%%p"  & Set "gcF_17=%%q"   & Set "gcF_18=%%r"     
   Set "gcF_19=%%s"  & Set "gcF_20=%%t"   & Set "gcF_21=%%u"     
   Set "gcF_22=%%v"  & Set "gcF_23=%%w"   & Set "gcF_24=%%x"     
   Set "gcF_25=%%y"    
)   

:: Datenzeilen der out.csv in Variablen einlesen 
:: ---Delimiter ist hier das Semikolon      
FOR /F "delims=; tokens=1-25" %%a in (out.csv) do (  

 (echo %ocF_01%: [%%a]) & (Echo %ocF_02%: [%%b]) & (echo %ocF_03%: [%%c])
 (Echo %ocF_04%: [%%d]) & (Echo %ocF_05%: [%%e]) & (Echo %ocF_06%: [%%f])
 (Echo %ocF_07%: [%%g]) & (Echo %ocF_08%: [%%h]) & (Echo %ocF_09%: [%%i])
 (Echo %ocF_10%: [%%j]) & (Echo %ocF_11%: [%%k]) & (Echo %ocF_12%: [%%l])
 (Echo %ocF_13%: [%%m]) & (Echo %ocF_14%: [%%n]) & (Echo %ocF_15%: [%%o])
 (Echo %ocF_16%: [%%p]) & (Echo %ocF_17%: [%%q]) & (Echo %ocF_18%: [%%r])
 (Echo %ocF_19%: [%%s]) & (Echo %ocF_20%: [%%t]) & (Echo %ocF_21%: [%%u])
 (Echo %ocF_22%: [%%v]) & (Echo %ocF_23%: [%%w]) & (Echo %ocF_24%: [%%x])
 (Echo %ocF_25%: [%%y])
)

:: -------- als nächstes die Datenzeilen der Gruppen.csv
:: -------- Delimiter ist hier ein TAB      
FOR /F "delims=	 tokens=1-25" %%a in (gruppen.csv) do (  

 (echo %gcF_01%: [%%a]) & (Echo %gcF_02%: [%%b]) & (echo %gcF_03%: [%%c])
 (Echo %gcF_04%: [%%d]) & (Echo %gcF_05%: [%%e]) & (Echo %gcF_06%: [%%f])
 (Echo %gcF_07%: [%%g]) & (Echo %gcF_08%: [%%h]) & (Echo %gcF_09%: [%%i])
 (Echo %gcF_10%: [%%j]) & (Echo %gcF_11%: [%%k]) & (Echo %gcF_12%: [%%l])
 (Echo %gcF_13%: [%%m]) & (Echo %gcF_14%: [%%n]) & (Echo %gcF_15%: [%%o])
 (Echo %gcF_16%: [%%p]) & (Echo %gcF_17%: [%%q]) & (Echo %gcF_18%: [%%r])
 (Echo %gcF_19%: [%%s]) & (Echo %gcF_20%: [%%t]) & (Echo %gcF_21%: [%%u])
 (Echo %gcF_22%: [%%v]) & (Echo %gcF_23%: [%%w]) & (Echo %gcF_24%: [%%x])
 (Echo %gcF_25%: [%%y])
)

...
L: [2]
TPNr: [47110815]
Name: [Muster]
Vorname: [Max]
Firma: [MM]
Angelegt: [02.02.2008]
L.Ums.: [40]
Tel.Privat: [0190666666]
Tel.Gesch.: [0190777777]
Mobiltelefon: [0190888888]
Fax: [0190999999]
Straße: [Maxstr. 99]
PLZ: [999999]
Ort: [Bibberstadt]
L.: [DE]
E-Mail: [max@muster.de]
M1L: [14]
QVM: [15]
QLM: [16]
QualVolumen: [17]
Struktur: [18]
Umsatz: [19]
Eigen: [20]
Promotion: [21]
Kunden: [22]

...
Vorname: [Max]
Nachname: [Muster]

Spitzname: [Max Muster ]
Primäre E-Mail: [max@muster.de ]
Sekundäre E-Mail: [0190777777]
Tel. dienstlich: [0190666666]
Tel. privat: [0190999999]
Fax-Nummer: [0190888888]
Pager-Nummer: [Maxstr. 99]
Mobil-Tel.-Nr.: [Bibberstadt]
Privat: Adresse: [999999]
Privat: Adresse 2: [DE]
Privat: Stadt: [47110815]
Privat: Bundesland: [02.02.2008]
Privat: PLZ: [2]
Privat: Land: [40]
Dienstlich: Adresse: [ - 14 - ]
Dienstlich: Adresse 2: [15 - ]
Dienstlich: Stadt: [16 - ]
Dienstlich: Bundesland: [17]
Dienstlich: PLZ: [ - 18 - ]
Dienstlich: Land: [19 - ]
Arbeitstitel: [20 - ]
Abteilung: [21 - ]

Option Explicit

Dim FileObj As New FileSystemObject 'VB-Editor Verweis include <Microsoft Scripting Runtime>  

Private Sub Workbook_Open()
    Call ConvertFile
    'ThisWorkbook.Close SaveChanges:=False  
End Sub

Function ConvertFile()
    Dim ix, ex, en, iPath As String, ePath As String
    Dim iFile As TextStream, eFile As TextStream
    
    On Error Resume Next
        
    iPath = ThisWorkbook.Path & "\pm.csv"  
    ePath = ThisWorkbook.Path & "\gruppe.csv"  
    
    en = Array("Vorname", "Nachname", "Anzeigename", "Spitzname", "Primäre E-Mail", _  
               "Sekundäre E-Mail", "Tel. dienstlich", "Tel. privat", "Fax-Nummer", _  
               "Pager-Nummer", "Mobil-Tel.-Nr.", "Privat: Adresse", "Privat: Adresse 2", _  
               "Privat: Stadt", "Privat: Bundesland", "Privat: PLZ", "Privat: Land", _  
               "Dienstlich: Adresse", "Dienstlich: Adresse 2", "Dienstlich: Stadt", _  
               "Dienstlich: Bundesland", "Dienstlich: PLZ", "Dienstlich: Land", _  
               "Arbeitstitel", "Abteilung", "Organisation", "Webseite 1", "Webseite 2", _  
               "Geburtsjahr", "Geburtsmonat", "Geburtstag", "Benutzerdef. 1", _  
               "Benutzerdef. 2", "Benutzerdef. 3", "Benutzerdef. 4", "Notizen")  
    
    
    Set iFile = FileObj.OpenTextFile(iPath)
    Set eFile = FileObj.CreateTextFile(ePath, True)
    
    If Err Then MsgBox "Datei nicht gefunden.", 48, "Fehler":  GoTo Ende  
    
    eFile.WriteLine Join(en, vbTab)
    iFile.SkipLine
    
    Do While iFile.AtEndOfStream = False
        ix = Split(iFile.ReadLine, ";")  
        If Not ix(0) = "" Then  
            ex = Array(ix(3), ix(2), ix(3) & ix(2), ix(3) & ix(2), ix(15), "", ix(8), _  
                       ix(7), ix(10), "", ix(9), ix(11), "", ix(13), "", ix(12), ix(14))  
            eFile.WriteLine Join(ex, vbTab)
        End If
    Loop
        
Ende:
    iFile.Close
    eFile.Close
    'Kill iPath 'Import-Datei löschen  
End Function

Option Explicit

Dim ix, ex, en, iPath, ePath
Dim FileObj, iFile, eFile
Set FileObj = CreateObject("Scripting.FileSystemObject")  
    
'On Error Resume Next  
        
iPath = WScript.Arguments(0)
ePath = WScript.Arguments(1)
    
en = Array("Vorname", "Nachname", "Anzeigename", "Spitzname", "Primäre E-Mail", _  
           "Sekundäre E-Mail", "Tel. dienstlich", "Tel. privat", "Fax-Nummer", _  
           "Pager-Nummer", "Mobil-Tel.-Nr.", "Privat: Adresse", "Privat: Adresse 2", _  
           "Privat: Stadt", "Privat: Bundesland", "Privat: PLZ", "Privat: Land", _  
           "Dienstlich: Adresse", "Dienstlich: Adresse 2", "Dienstlich: Stadt", _  
           "Dienstlich: Bundesland", "Dienstlich: PLZ", "Dienstlich: Land", _  
           "Arbeitstitel", "Abteilung", "Organisation", "Webseite 1", "Webseite 2", _  
           "Geburtsjahr", "Geburtsmonat", "Geburtstag", "Benutzerdef. 1", _  
           "Benutzerdef. 2", "Benutzerdef. 3", "Benutzerdef. 4", "Notizen")  
    
    
Set iFile = FileObj.OpenTextFile(iPath)
Set eFile = FileObj.CreateTextFile(ePath, True)
    
If Err Then MsgBox "Datei nicht gefunden.", 48, "Fehler":  WScript.Quit 1 'Errorlevel setzen  
    
eFile.WriteLine Join(en, vbTab)
iFile.SkipLine
    
Do While iFile.AtEndOfStream = False
    ix = Split(iFile.ReadLine, ";")  
    If Not ix(0) = "" Then  
        ex = Array(ix(3), ix(2), ix(3) & ix(2), ix(3) & ix(2), ix(15), "", ix(8), _  
                   ix(7), ix(10), "", ix(9), ix(11), "", ix(13), "", ix(12), ix(14))  
        eFile.WriteLine Join(ex, vbTab)
    End If
Loop
        
iFile.Close
eFile.Close
'FileObj.DeleteFile iPath 'Import-Datei löschen  

cscript //nologo C:\Scripts\ConvertCSV.vbs "D:\Ein-Pfad\pm.csv" "D:\Aus-Pfad\gruppe.csv"

REM iFile.SkipLine

>>D:\Aus-Pfad\gruppe.csv

If Trim(Join(ix)) <> "" Then

ix = Split(iFile.ReadLine, ";")  
If UBound(ix) = -1 Then MsgBox "Ungültige ASCII-Zeichen..", 48, "Fehler": WScript.Quit 1 'Errorlevel setzen  
If Not ix(0) = "" Then  

If Trim(Join(ix)) <> "" Then

Do While iFile.AtEndOfStream = False
    ix = Split(iFile.ReadLine, ";")  
    If Trim(Join(ix)) <> "" Then  
        If ix(0) = "" Then ix(0) = "0"  
        If ix(6) = "-" Then ix(6) = "00.0000"  
        ex = Array(ix(3), ix(2), ix(3) & " " & ix(2), ix(3) & " " & ix(2), _  
                   ix(15), "", ix(8), ix(7), _  
                   ix(10), "", ix(9), ix(11), _  
                   "", ix(13), "", ix(12), _  
                   ix(14), "", "", "", _  
                   "", "", "", "", _  
                   "", ix(4), "", "", _  
                   "", "", "", ix(1), _  
                   "", ix(0), ix(5), _  
                   ix(6) & " - " & ix(16) & " - " & ix(17) & " - " & ix(18) & " - " _  
                   & ix(19) & " - " & ix(20) & " - " & ix(21) & " - " & ix(22) & _  
                   " - " & ix(23) & " - " & ix(24))  
        eFile.WriteLine Join(ex, vbTab)
    End If
Loop

Option Explicit

Dim ix, ex, en, iPath, ePath, aPath
Dim FileObj, iFile, eFile, aFile
Dim DataList, LastLine, ThisLine
Set FileObj = CreateObject("Scripting.FileSystemObject")  

iPath = WScript.Arguments(0) 'Eingabedatei  
ePath = WScript.Arguments(1) 'Ausgabedatei  
aPath = WScript.Arguments(2) 'Datei für ausgeschiedene Zeilen  

en = Array("Vorname", "Nachname", "Anzeigename", "Spitzname", _  
           "Primäre E-Mail", "Sekundäre E-Mail", "Tel. dienstlich", "Tel. privat", _  
           "Fax-Nummer", "Pager-Nummer", "Mobil-Tel.-Nr.", "Privat: Adresse", _  
           "Privat: Adresse 2", "Privat: Stadt", "Privat: Bundesland", "Privat: PLZ", _  
           "Privat: Land", "Dienstlich: Adresse", "Dienstlich: Adresse 2", "Dienstlich: Stadt", _  
           "Dienstlich: Bundesland", "Dienstlich: PLZ", "Dienstlich: Land", "Arbeitstitel", _  
           "Abteilung", "Organisation", "Webseite 1", "Webseite 2", _  
           "Geburtsjahr", "Geburtsmonat", "Geburtstag", "Benutzerdef. 1", _  
           "Benutzerdef. 2", "Benutzerdef. 3", "Benutzerdef. 4", "Notizen")  

Set iFile = FileObj.OpenTextFile(iPath)
If Err Then MsgBox "Datei nicht gefunden.", 48, "Fehler": WScript.Quit 1 'Errorlevel setzen  

'Datenbank erzeugen und öffnen  
Const adVarChar = 200
Const adFldIsNullable = 32
Const adInteger = 3

Set DataList = CreateObject("ADOR.Recordset")  
DataList.Fields.Append "Name", adVarChar, 64, adFldIsNullable     'Feldgröße (64 Zeichen) für "Nachname"+"Vorname" bei Bedarf anpassen  
DataList.Fields.Append "Zeile", adVarChar, 1024, adFldIsNullable  'Feldgröße (1024 Zeichen) für gesamte Ausgabezeile  
DataList.Open

'Bis auf die erste Zeile alle weiteren Zeilen aus CSV lesen und konvertieren  
iFile.SkipLine
Do While iFile.AtEndOfStream = False
    ix = Split(iFile.ReadLine, ";")  
    If Trim(Join(ix)) <> "" Then  
        If ix(0) = "" Then ix(0) = "0"  
        If ix(6) = "-" Then ix(6) = "00.0000"  
        'Neue Ausgabezeile erstellen  
        ex = Array(ix(3), ix(2), ix(3) & " " & ix(2), ix(3) & " " & ix(2), _  
                   ix(15), "", ix(8), ix(7), _  
                   ix(10), "", ix(9), ix(11), _  
                   "", ix(13), "", ix(12), _  
                   ix(14), "", "", "", _  
                   "", "", "", "", _  
                   "", ix(4), "", "", _  
                   "", "", "", ix(1), _  
                   "", ix(0), ix(5), _  
                   ix(6) & " - " & ix(16) & " - " & ix(17) & " - " & ix(18) & " - " _  
                   & ix(19) & " - " & ix(20) & " - " & ix(21) & " - " & ix(22) & _  
                   " - " & ix(23) & " - " & ix(24))  
        'Satz in Datenbank schreiben  
        DataList.AddNew
        DataList("Name") = LCase(ix(3) & " " & ix(2)) 'Sortierkriterium = Anzeigename (in Kleinbuchstaben)  
        DataList("Zeile") = Join(ex, vbTab)     'gesamte Ausgabezeile  
        DataList.Update
    End If
Loop
iFile.Close

'Ausgabedatei erzeugen und Kopfzeile schreiben  
Set eFile = FileObj.CreateTextFile(ePath, True)
eFile.WriteLine Join(en, vbTab)

'Datei für ausgeschiedene Zeilen erzeugen und Kopfzeile schreiben  
Set aFile = FileObj.CreateTextFile(aPath, True)
aFile.WriteLine Join(en, vbTab)

LastLine = "" 'Initialisierung "letzte geschriebene Zeile"  
DataList.Sort = "Name" 'Datenbank nach Feld "Name" sortieren  
DataList.MoveFirst 'zum ersten Datensatz  
Do Until DataList.EOF 'Schleife über alle Datensätze  
    ThisLine = DataList.Fields.Item("Zeile") 'Ausgabezeile aus Datenbank lesen  
    'Vergleich der gesamten Zeile ohne Berücksichtigung von Groß-/Kleinschreibung  
    If LCase(ThisLine) <> LCase(LastLine) Then 
        eFile.WriteLine ThisLine 'kein Duplikat - Zeile in Ausgabedatei schreiben  
        LastLine = ThisLine 'geschriebene Zeile merken  
    Else 'Duplikat gefunden  
        aFile.WriteLine ThisLine 'ausgeschiedene Zeile schreiben  
    End If
    DataList.MoveNext 'zum nächsten Datensatz  
Loop
eFile.Close
aFile.Close
'FileObj.DeleteFile iPath 'Import-Datei löschen  

cscript //nologo C:\Scripts\ConvertCSV.vbs "D:\Ein-Pfad\pm.csv" "D:\Aus-Pfad\gruppe.csv" "D:\Aus-Pfad\ausgeschieden.csv"

Batch: cscript //nologo X:\Scripts\ConvertCSV.vbs

Die Batch ist nicht erforderlich, ConvertCVS kann direkt mit Doppelklick auf die Datei oder Verknüpfung gestartet werden.


Option Explicit

'Dateinamen hier festlegen  
Const GDbName = "\PM-DB.ADT"     'Export-Datei Datenbank gesammelte Geburtsdaten (Import GEBURTSTAG.CSV)  
Const DupName = "\DUPLETTEN.CSV"     'Export-Datei Duplikate (Import PM-I.CSV)  
Const ExpName = "\GRUPPEN.CSV"     'Export-Datei ohne Duplikate mit Geburtsdaten (Import PM-I.CSV + PM-DB.ADT)  
Const GebName = "\GEBURTSTAG.CSV"     'Import-Datei Geburtstage für 30 Tage  
Const ImpName = "\PM-I.CSV"     'Import-Datei Allgemeine Daten  

'ADO-Recordset  
Const adInteger = 3                 
Const adVarChar = 200
Const adOpenKeyset = 1
Const adPersistXML = 1
Const adPersistADTG = 0
Const adFldIsNullable = 32

Dim FileObj, ImpFile, ExpFile, DupFile, GebFile
Dim VbsPath, ImpPath, ExpPath, DupPath, GebPath, GDbPath
Dim ix, gx, expData, expFeld, DataList, GDbList, LastLine, ThisLine


'Main Begin  

    Set FileObj = CreateObject("Scripting.FileSystemObject")       'Bibliothek Dateifunktionen  

    VbsPath = FileObj.GetParentFolderName(Wscript.ScriptFullname)    'Dateipfad Script-Datei  


    'Dateipfad Konvertierungs-Dateien  
    GDbPath = VbsPath & GDbName
    DupPath = VbsPath & DupName
    ExpPath = VbsPath & ExpName
    GebPath = VbsPath & GebName
    ImpPath = VbsPath & ImpName

    
    'Feldnamen Export-Datei  
    expFeld = Array("Vorname", "Nachname", "Anzeigename", "Spitzname", _  
                    "Primäre E-Mail", "Sekundäre E-Mail", "Tel. dienstlich", "Tel. privat", _  
                    "Fax-Nummer", "Pager-Nummer", "Mobil-Tel.-Nr.", "Privat: Adresse", _  
                    "Privat: Adresse 2", "Privat: Stadt", "Privat: Bundesland", "Privat: PLZ", _  
                    "Privat: Land", "Dienstlich: Adresse", "Dienstlich: Adresse 2", "Dienstlich: Stadt", _  
                    "Dienstlich: Bundesland", "Dienstlich: PLZ", "Dienstlich: Land", "Arbeitstitel", _  
                    "Abteilung", "Organisation", "Webseite 1", "Webseite 2", _  
                    "Geburtsjahr", "Geburtsmonat", "Geburtstag", "Benutzerdef. 1", _  
                    "Benutzerdef. 2", "Benutzerdef. 3", "Benutzerdef. 4", "Notizen")  
    
    Call OpenGDbList      'Datenbank mit Geburtsdaten erzeugen/öffnen  
    
    'Neue Geburtsdaten in Datenbank übernehmen  
    If FileObj.FileExists(GebPath) Then    'Test ob neue Datei mit Geburtsdaten existiert  
        Set GebFile = FileObj.OpenTextFile(GebPath)  
        With GebFile    'Datei Zeilenweise einlesen und neue Daten in Datenbank schreiben  
           .SkipLine
            Do Until .AtEndOfStream
                ix = Split(.ReadLine, ";")  
                If Trim(Join(ix)) <> "" Then Call WriteGDbList  
            Loop
           .Close
        End With
        With GDbList    'Datenbank Geburtstage sortieren und speichern  
           .Sort = "TP-Nr"  
           .Save GDbPath, adPersistADTG
        End With
    End If

    Call OpenDataList    'Recordset für Allgemeine Daten erzeugen  
    
    Set ImpFile = FileObj.OpenTextFile(ImpPath)
    
    With ImpFile    'Daten einlesen und nach Export-Feldnamen sortiert in Recordset schreiben  
       .SkipLine
        Do Until .AtEndOfStream
            ix = Split(.ReadLine, ";")  
            If Trim(Join(ix)) <> "" Then  
                Call InitGebData
                If ix(0) = "" Then ix(0) = "0"  
                If ix(6) = "-" Then ix(6) = "00.0000"  
                expData = Array(ix(3), ix(2), ix(3) & " " & ix(2), ix(3) & " " & ix(2), _  
                                ix(15), "", ix(8), ix(7), ix(10), "", ix(9), ix(11), "", ix(13), "", _  
                                ix(12), ix(14), "", "", "", "", "", "", "", "", ix(4), "", "", gx(2), _  
                                gx(1), gx(0), ix(1), "", ix(0), ix(5), _  
                                ix(6) & " ; " & ix(16) & " ; " & ix(17) & " ; " & ix(18) & " ; " & _  
                                ix(19) & " ; " & ix(20) & " ; " & ix(21) & " ; " & ix(22) & " ; " & _  
                                ix(23) & " ; " & ix(24))  
                Call WriteDataList
            End If
        Loop
       .Close
    End With
    
    Set ExpFile = FileObj.CreateTextFile(ExpPath, True)
    ExpFile.WriteLine Join(expFeld, vbTab)   'Feldnamen speichern  
    
    Set DupFile = FileObj.CreateTextFile(DupPath, True)
    DupFile.WriteLine Join(expFeld, vbTab)   'Feldnamen speichern  
    
    With DataList   'Daten aus Recordset in Export-Datei und Duplikate-Datei schreiben  
        LastLine = ""  
       .Sort = "Name"  
       .MoveFirst
        Do Until DataList.EOF
            ThisLine = .Fields("Zeile")  
            If StrComp(ThisLine, LastLine, vbTextCompare) Then
                ExpFile.WriteLine ThisLine
                LastLine = ThisLine
            Else
                DupFile.WriteLine ThisLine
            End If
           .MoveNext
        Loop
    End With
    
    ExpFile.Close:  DupFile.Close:  DataList.Close:  GDbList.Close   'Objecte schließen  
    
    With FileObj
        '.DeleteFile GebPath: .DeleteFile ImpPath   'Dateien löschen  
    End With

    WScript.Quit 0 'Errorlevel setzen  

'Main End  


Private Sub OpenDataList()  'ADO-Recordset erzeugen  
    Set DataList = CreateObject("ADOR.Recordset")  
    With DataList.Fields
        .Append "Name", adVarChar, 64, adFldIsNullable  
        .Append "Zeile", adVarChar, 1024, adFldIsNullable  
         DataList.Open
    End With
End Sub

Private Sub WriteDataList() 'In ADO-Recordset schreiben  
    With DataList
        .AddNew
        .Fields("Name") = LCase(ix(3) & " " & ix(2))  
        .Fields("Zeile") = Join(expData, vbTab)  
        .Update
    End With
End Sub

Private Sub OpenGDbList()   'Datenbank Geburtsdaten erzeugen/öffnen  
    Set GDbList = CreateObject("ADOR.Recordset")  
    If FileObj.FileExists(GDbPath) Then
        With GDbList
            .CursorType = adOpenKeyset
            .Open GDbPath
        End With
    Else
        With GDbList.Fields
            .Append "TP-Nr", adVarChar, 24, adFldIsNullable  
            .Append "Datum", adVarChar, 16, adFldIsNullable  
             GDbList.Open
        End With
    End If
End Sub

Private Sub WriteGDbList()  'Geburtsdaten in Datenbank schreiben (nur neue Einträge)  
    With GDbList
        If .RecordCount Then
            .MoveFirst
            .Find = "TP-Nr = " & ix(3)  
             If Not .EOF Then Exit Sub
        End If
       .AddNew
       .Fields("TP-Nr") = ix(3)  
       .Fields("Datum") = ix(1)  
       .Update
    End With
End Sub

Private Sub InitGebData()   'Geburtsdaten in Datenbank suchen und auslesen  
    Dim datum
    gx = Array("", "", "")  
    With GDbList
        If .RecordCount Then
            .MoveFirst
            .Find = "TP-Nr = " & ix(1)  
             If Not .EOF Then
                datum = Split(.Fields("Datum"), ".")  
                If UBound(datum) = 2 Then gx = datum
             End If
        End If
    End With
End Sub