AW: Import TXT/CSV-Datei mit Bedingungen
27.01.2013 01:46:43
fcs
Hallo Joern,
da gab es jetzt noch 3 kleine Baustellen im Code.
1. Ich hatte versehentlich einen absichtlichen Fehler zum Testen der Fehlerfunktion nicht wieder rückgängig gemacht.
Set wksImport = wbImport.Worksheets(2)
muss sein:
Set wksImport = wbImport.Worksheets(1)
2. Das Trenzeichen in deiner txt/csv-Datei ist ";" und nicht "," wie in deinen zuerst gepostetn Beispieldaten.
Hier hab ich eine Variable eingefügt, in der das Trennzechen gesetzt werden kann.
3, Deine CSV-Datei enthält am Ende auch leere Zeilen.
Diese erzeugt beim Splitten kein Array, so dass
VBA.Split(strDaten2, ",")(0)
auch einen Index-Fehler erzeugt.
Nachfolgend das Makro mit entsprechenden Korrekturen/Anpassungen.
Gruß
Franz
'Makro in einem allgemeinen Modul
Sub Text_Datei_Importieren()
Dim strDaten As String, strDaten2 As String, strMldg
Dim varDaten, intJ As Integer, strSep As String
Dim wbImport As Workbook
Dim wksImport As Worksheet
Dim ZeileImport As Long
Dim varDatei, intFF As Integer
On Error GoTo Fehler
strSep = ";" 'Trennzeichen zwischen Datenfeldern
'Datei auswählen
varDatei = Application.GetOpenFilename( _
Filefilter:="text-CSV (*.txt;*.csv),*.txt;*.csv", _
Title:="Bitte Datei mit Importdaten auswählen")
If varDatei = False Then GoTo Fehler
'Ausgabedatei erstellen - hier kann natürlci auch eine vorhandene Datei/Tabelle _
für den Import als Ziel definiert werden.
Set wbImport = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksImport = wbImport.Worksheets(1)
With wksImport
ZeileImport = 1 'unterhalb dieser Zeile werdne die Daten eingetragen
'Zeilen/Splaten fixieren
ActiveSheet.Range("D2").Select
ActiveWindow.FreezePanes = True
End With
Application.ScreenUpdating = False
'Daten aus Textdateien importieren
intFF = FreeFile()
'txt/csv-Datei für Datenimport öffnen
Open varDatei For Input As #intFF
'1. Datenzeile als Datensatz einlesen
Do Until strDaten ""
Line Input #intFF, strDaten
If EOF(intFF) Then GoTo Close_Datei
Loop
Do Until EOF(intFF)
'nächste Datenzeile einlesen bis zum Dateiende
Line Input #intFF, strDaten2
'Prüfen, ob Datenzeile leer
If strDaten2 "" Then
'Prüfen, ob Kopfnummer identisch
If VBA.Split(strDaten, strSep)(0) = VBA.Split(strDaten2, strSep)(0) Then
'Datenzeile an Datensatz anfügen
strDaten = strDaten & Mid(strDaten2, InStr(1, strDaten2, strSep))
strDaten2 = ""
Else
'Daten in Tabelle eintragen
ZeileImport = ZeileImport + 1
varDaten = Split(strDaten, strSep)
For intJ = 0 To UBound(varDaten)
wksImport.Cells(ZeileImport, intJ + 1).Value = varDaten(intJ)
Next
'Datenzeile in neuen Datensatz übernehmen
strDaten = strDaten2
End If
End If
Loop
Close_Datei:
Close #intFF 'txt/csv-Datei wieder schliessen
If strDaten "" Then
'letzten Datensatz eintragen
ZeileImport = ZeileImport + 1
varDaten = Split(strDaten, strSep)
For intJ = 0 To UBound(varDaten)
wksImport.Cells(ZeileImport, intJ + 1).Value = varDaten(intJ)
Next
End If
'Spaltenbreite optimieren
With wksImport
.UsedRange.EntireColumn.ColumnWidth = 2
.Columns.AutoFit
End With
Err.Clear
Fehler:
Application.ScreenUpdating = True
With Err
If .Number 0 Then
Select Case .Number
Case 99999
'keine spezifischen Fehler definiert
Case Else
strMldg = "Fehler-Nr.: " & Str(.Number) & vbLf & " wurde ausgelöst in " _
& "Excel-Makro ""Text_Datei_Importieren""" & vbLf & .Description
MsgBox strMldg, vbInformation + vbOKOnly, "Fehler", .HelpFile, .HelpContext
End Select
End If
End With
Close 'alle mit Open geöffneten Dateien schliessen
Set wbImport = Nothing
Set wksImport = Nothing
End Sub