Problem beim einlesen, einer txt Datei in DB-Tabel
22.06.2007 19:54:57
Brunken
habe mit deiesem Code ein kleines Problem. Die Textdatei die damit wieder eingelesen wird ist ok
in meiner Tabelle werden die Zahlen Umgewandelt, und korrekt angezeigt. Nur die Spalte F42 in meiner
Tabelle fehlen nach einlesen der txt Datei alle Werte?
Wer kann helfen (der Code wurde mir von Luschi zur Verfügung gestellt) er funktioniert bis eben dahin.
Function Produktionszahlen_importieren()
Dim db As Database, _
rst As Recordset, _
sqlText As String, s1 As String, s2 As String, s3 As String, _
myArr() As String, _
n1 As Long, n2 As Long, i1 As Integer
Set db = CurrentDb()
'alle Datensätze löschen
sqlText = "Delete * From Produktion_Nacharbeit;"
db.Execute sqlText
'Tabelle als RecordSet öffnen
Set rst = db.OpenRecordset("Produktion_Nacharbeit")
''On Error GoTo err_01
'hier Pfad und Textdatei-Name ändern
s1 = Application.CurrentProject.Path & "\Produktion_Nacharbeit.txt"
n2 = 0 'Zeilennummer der Textdatei mitzählen _
falls Fehler auftritt, kann man in der txt-Datei nachschauen
'Textdatei sequentiell einlesen
i1 = FreeFile
Open s1 For Input As #i1
Do While Not EOF(i1)
n2 = n2 + 1
'neue Zeile aus txt-Datei einlesen
Line Input #i1, s2
s2 = Trim(s2)
'einige Zeilen haben als letztes Zeichen noch ein ";" _
--> wird entfernt
If Right(s2, 1) = ";" Then
n1 = Len(s2)
s2 = Left(s2, n1 - 1)
End If
'die Anführungsstriche bei Textwerten entfernen
s2 = Replace(s2, Chr(34), "", 1, -1, vbTextCompare)
'akt. Zeile in ein Array aufteilen
myArr() = Split(s2, ";", -1, vbTextCompare)
'neuen Datensatz in Tabelle erzeugen
rst.AddNew
'alle Elemente des Array's durchlaufen
For n1 = 1 To UBound(myArr()) 'hier 42
'bei bestimmten Werten im Array Typumwandlung durchführen
Select Case n1
Case 1
'Datum
rst.Fields("F" & n1).Value = CDate(myArr(n1 - 1))
Case 14 To 17, 29, 31, 32
'Kommazahlen
rst.Fields("F" & n1).Value = CDbl(myArr(n1 - 1))
Case 42
'Zahlen
rst.Fields("F" & n1).Value = CLng(myArr(n1 - 1))
Case 2, 5, 27, 28, 30
'Text
rst.Fields("F" & n1).Value = myArr(n1 - 1)
Case Else
'ganzzahlige Werte
s3 = Trim(myArr(n1 - 1))
If "" = s3 Then
'Zeilen 36/43 Spalte 11 in der txt-Datei sind leer statt Zahl
s3 = "-1"
End If
rst.Fields("F" & n1).Value = CLng(s3)
End Select
Next n1
'Datensatz in Tabelle schreiben
rst.Update
Loop
'Lesen der txt-Datei beendet
'Textdatei schließen
Close #i1
'Access-Objecte schließen und Zeiger auf Objekte entfernen
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
s1 = "F e r t i g" & vbCrLf & vbCrLf & "[man ging das schnell...]"
MsgBox s1, 48, "zur Informatiion"
Exit Function
err_01:
MsgBox n1 & " - " & Chr(34) & myArr(n1 - 1) & Chr(34)
Resume Next
End Function