Makro Text Datei importieren

Question

Hallo,

habe keine VBA Kenntnisse :) & habe ein Makro gefunden, dass sich sehr gut nutzen lässt und auch funktioniert.

Allerdings werden die Texte unvollständig dargestellt - betrifft ä ü ö z.B.
Jörg Mü

Lässt es sich einstellen, dass die Daten in einem anderen Format importier werden? Manuell wähle ich immer 65001 : (UTF-8) aus.

und wo müsste der Formatbefehl hin?

------------------
Das Makro sieht folgendermaßen aus:


Sub Open_TextFile_DE()
'
'
Dim varDateiName As Variant, arrFieldInfo() As Long, intSpalte As Integer
varDateiName = Application.GetOpenFilename(Filefilter:="Textfile (*.txt),*.txt", _
Title:="Bitte Textdatei mit Daten auswählen")
If varDateiName = False Then Exit Sub
intSpalte = 6 'Anzahl Spalten in Textdatei - sind mehr Spalten enthalten, dann werden _
diese als Standard importiert.
ReDim arrFieldInfo(1 To intSpalte, 1 To 2)
'Erstellung des FieldInfo-Arrays für die Spaltenformate
For intSpalte = 1 To UBound(arrFieldInfo, 1)
arrFieldInfo(intSpalte, 1) = intSpalte
Select Case intSpalte
Case 1
arrFieldInfo(intSpalte, 2) = 2 'Import als Text
Case 2
arrFieldInfo(intSpalte, 2) = 3 'Datum MTJ, z.B. US MM/TT/JJJJ
Case 4
arrFieldInfo(intSpalte, 2) = 4 'Datum TMJ, z.B. DE TT.MM.JJJJ
Case 3
arrFieldInfo(intSpalte, 2) = 5 'Datum JMT, z.B. ISO JJJJ-MM-TT
Case 999
arrFieldInfo(intSpalte, 2) = 9 'Spalte nicht importieren
Case Else 'Import als Standard - Excel für Konversionen automatisch durch
arrFieldInfo(intSpalte, 2) = 1 'Import als Standard - Excel für Konversionen _
automatisch durch
End Select
Next intSpalte

Application.Workbooks.OpenText Filename:=varDateiName, Origin:=xlWindows, Startrow:=1, _
DataType:=xlDelimited, Textqualifier:=xlTextQualifierDoubleQuote, _
Consecutivedelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, Fieldinfo:=arrFieldInfo, _
DecimalSeparator:=".", ThousandsSeparator:=",", Trailingminusnumbers:=True
End Sub

Answer 1

Ersetze Origin:=xlWindows durch Origin:=65001 für UTF8

Answer 2

Hi xlKing

das ging ja schnell super & Danke :)

Vlt. kannst Du mir nochmal helfen: Wenn ich das Makro mehrfach ausführen möchte.
Jetzt wird immer nur ein Tabellenblatt befüllt und ich muss zwischenspeichern oder die Daten werden überschrieben.

Wie lassen sich denn mit dem Makro (ich gehe in ein neues Tabellenblatt) die jeweiligen aktiven Tabellenblätter befüllen?

Doof gefragt - habe aber leider (noch) keine Ahnung von VBA

VG
Matthias

Answer 3

Hallo Happy,

sorry. Bin gestern erst spät heim gekommen. Sehe grad erst deine Zusatzfrage.

Antwort: Gar nicht! Mit diesem Makro öffnest du lediglich die Textdatei zur Ansicht in Excel. (Entspricht dem Dialog Datei Öffnen)
Die Datei bleibt aber weiterhin im Textformat erhalten. Eine Textdatei kann immer nur ein Tabellenblatt enthalten. Wenn du weitere Tabellenblätter hinzufügen willst musst du die Datei als Exceldatei (.xlsx) speichern. Wenn du nun aber erneut über Workbooks.Open gehst öffnest du eine Neue Datei.

Deshalb nutze ich diese Funktion so nie sondern gehe immer über den Textdatei-Import-Assistenten. Dieser kann sich in einer bestehenden Excel-Datei Daten aus beliebig vielen Textdateien holen. Du findest den im Register "Daten" unter dem Symbol "Aus Text". Der Aufbau ist dabei ähnlich, nur dass hier eben lediglich auf die Textdatei mit reiner Leseberechtigung verlinkt wird. Willst du deine Änderungen wieder als reine Textdatei speichern, so musst du dann jedes Tabellenblatt einzeln anwählen und speichern (Kann man natürlich dem Code auch noch hinzufügen, falls gewünscht)

Sub Open_TextFile_DE()
'
'
Dim varDateiName As Variant, arrFieldInfo() As Long, intSpalte As Integer, intDatei As Integer

varDateiName = Application.GetOpenFilename(Filefilter:="Textfile (*.txt),*.txt", MultiSelect:=True, _
Title:="Bitte Textdatei mit Daten auswählen")

If TypeName(varDateiName) = "Boolean" Then Exit Sub

intSpalte = 6 'Anzahl Spalten in Textdatei - sind mehr Spalten enthalten, dann werden diese _
als Standard importiert.

ReDim arrFieldInfo(1 To intSpalte)
'Erstellung des FieldInfo-Arrays für die Spaltenformate

For intSpalte = 1 To UBound(arrFieldInfo)
Select Case intSpalte
Case 1 'Spalte 1
arrFieldInfo(intSpalte) = 2 'Import als Text
Case 2 'Spalte 2
arrFieldInfo(intSpalte) = 3 'Datum MTJ, z.B. US MM/TT/JJJJ
Case 4 'Spalte 4
arrFieldInfo(intSpalte) = 4 'Datum TMJ, z.B. DE TT.MM.JJJJ
Case 3 'Spalte 3
arrFieldInfo(intSpalte) = 5 'Datum JMT, z.B. ISO JJJJ-MM-TT
Case 999
arrFieldInfo(intSpalte) = 9 'Spalte nicht importieren
Case Else 'Import als Standard - Excel für Konversionen automatisch durch
arrFieldInfo(intSpalte) = 1 'Import als Standard - Excel für Konversionen automatisch durch
End Select
Next intSpalte


For intDatei = 1 To UBound(varDateiName)

ActiveWorkbook.Worksheets.Add After:=ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varDateiName(intDatei), Destination:=Range("A1"))
'.Name = "Mappe2" 'optionaler Name für die Abfrage
.FieldNames = True 'wenn die Textdatei Spaltenüberschriften hat.
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001 'UTF8
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = arrFieldInfo
.Refresh BackgroundQuery:=False
End With
Next intDatei

End Sub

Frage: Bist du sicher dass dein Code so richtig ist? Wenn ich das recht verstehe importierst du die 1. Spalte als Text, die 2. im US-Datumsformat, die 3. im Datumsformat nach DIN 5008 und erst die 4. Spalte im deutschen Datumsformat. Hab das mal so übernommen. Testen kann ich es leider nicht, da mir keine Beispieldatei vorliegt. Probier es also bitte mal selbst aus.

Übrigens kannst du im Dialog bei gedückt gehaltener Shift- oder STRG-Taste jetzt auch mehrere Dateien gleichzeitig importieren.

Gruß Mr. K.

Answer 4

Hi xlKing,

danke erst mal für die Arbeit! :)

habe die Datei mal ausprobiert. Vlt. kannst Du mir noch ein paar Tipps geben.

Case 1 'Spalte 1
arrFieldInfo(intSpalte) = 2 'Import als Text
Die Spalte A ist schon mal okay.

Allerdings kommen die Datumswerte nicht korrekt an - daher noch mal die Frage:

Wie muss ich denn das Datum importieren, wenn in der Text Datei z.B. 19-MAY-16 steht?

Das Datum steht in den Spalten 6,14,33,35,36 und 39 (die Befehle würde ich dann anpassen)

In den Spalten 29 und 30 sind Eurobeträge, die aus amerikanischem Format kommen (also mit Punkt statt Komma) - hier kommt kein sinnvolles Ergebnis raus.

Answer 5

Hallo Happy,

also das mit dem Datum ist ein kleiner Knackpunkt. Leider kannst du nirgends die Sprache mitgeben, in
der die Datei vorliegt. Soweit ich das verstanden habe, geht immer nur um Formate und
Zeichendarstellung. Kann natürlich sein, dass ich mich da irre. Wenn du also keine Lust hast jedes Mal
vor dem Import dein Excel auf Englisch umzuschalten (was m.W. erst nach Schließen und Neustart von
Excel wirksam würde) bleibt dir nur das klassische Suchen&Ersetzen der englischen Monatsnamen.

Dazu ist müsstest du den Code wie folgt umschreiben:

Sub Open_TextFile_DE()
'
'
Dim varDateiName As Variant, arrFieldInfo() As Long
Dim intSpalte As Integer, intDatei As Integer

varDateiName = Application.GetOpenFilename(Filefilter:= _
"Textfile (*.txt),*.txt", MultiSelect:=True, _
Title:="Bitte Textdatei mit Daten auswählen")

If TypeName(varDateiName) = "Boolean" Then Exit Sub

intSpalte = 39 'Anzahl Spalten in Textdatei - sind mehr _
Spalten enthalten, dann werden diese als Standard importiert.

ReDim arrFieldInfo(1 To intSpalte)
'Erstellung des FieldInfo-Arrays für die Spaltenformate

For intSpalte = 1 To UBound(arrFieldInfo)
Select Case intSpalte
Case 1 'Spalte 1
arrFieldInfo(intSpalte) = 2 'Import als Text
Case 6, 14, 33, 35, 36, 39
arrFieldInfo(intSpalte) = 4 'Datum TMJ, z.B. DE TT.MM.JJJJ
Case 999
arrFieldInfo(intSpalte) = 9 'Spalte nicht importieren
Case Else 'Import als Standard
arrFieldInfo(intSpalte) = 1 'Import als Standard
End Select
Next intSpalte


For intDatei = 1 To UBound(varDateiName)

ActiveWorkbook.Worksheets.Add After:=ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varDateiName(intDatei), Destination:=Range("A1"))
'.Name = "Mappe2" 'optionaler Name für die Abfrage
.FieldNames = True 'wenn die Textdatei Spaltenüberschriften hat.
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001 'UTF8
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = arrFieldInfo
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.Refresh BackgroundQuery:=False
End With

'verarbeitet englische Datumsangaben nachträglich
With Range("B:B,F:F,N:N,AG:AG,AI:AI,AJ:AJ,AM:AM")
.NumberFormat = "dd. mmm yyyy"

'ersetzt englische Monatsnamen
.Replace "January", 1
.Replace "February", 2
.Replace "March", 3
.Replace "May", 5
.Replace "June", 6
.Replace "July", 7
.Replace "October", 10
.Replace "December", 12

'macht aus dem Text ein Datumsformat
For Each c In .Columns
Select Case c.Address(0, 0)
Case "B:B", "F:F", "N:N", "AG:AG", "AI:AI", "AJ:AJ", "AM:AM"
zwsp = c
c = zwsp
End Select
Next c
End With
Next intDatei

End Sub

Mit den zusätzlichen Zeilen
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = "," (siehe Code)
dürfte sich dann auch dein zweites Problem erledigt haben.

Gruß Mr. K.

Answer 6

Jetzt hab ich doch glatt vergessen die zusätzliche Deklaration mit reinzukopieren.
Bei Problemen, füge oben unter Dim noch die Zeile
Dim c As Range, zwsp() 'Zwischenspeicher
hinzu. Müsste aber auch ohne gehen.

Answer 7

Hallo xlKing,

danke - ich lerne dazu - :)

Die Umwandlung von Text in Datumsformat funktioniert noch nicht - die Ersetzung klappt zwar, die Daten werden aber nicht als Datum erkannt / interpretiert.

'macht aus dem Text ein Datumsformat
For Each c In .Columns
Select Case c.Address(0, 0)
Case "B:B", "F:F", "N:N", "AG:AG", "AI:AI", "AJ:AJ", "AM:AM"
zwsp = c
c = zwsp
End Select

Bsp. Ergebnis:
17-5-16
19-5-16
13-5-16
23.04.2016
05.12.2016
05.09.2016
18-5-16
14-5-16
14-5-16
18-5-16
13-5-16

Answer 8

Hallo Happy,

Ich konnte das Problem heute in Excel 2010 nachvollziehen. Keine Ahnung, warum das da nicht klappt.
Bei mir hat das gestern einwandfrei funktioniert. Warum hat nur heute keiner mehr das gute Alte Excel
2000? Damals war die Welt noch in Ordnung. Symbole, die thematisch zueinander gehörten, fand man
auf Einer Symbolleiste und nicht so verstreut oder gar tief versteckt wie heutzutage. Und die VBA-Befehle
funktionierten noch (zumindest Größtenteils, wenn man mal von ein paar kleinen Bugs absieht, die
Microsoft bis heute nicht gelöst hat.)

Dann müssen wir eben doch über die Schleife gehen. und jede Datumszelle einzeln ansprechen.
Hoffentlich gibt's davon nicht zu viele. Ersetze dazu den Teil von With Range bis End With durch

'verarbeitet englische Datumsangaben nachträglich
Set r = Range("B:B,F:F,N:N,AG:AG,AI:AI,AJ:AJ,AM:AM")
r.NumberFormat = "dd. mmm yyyy"

'ersetzt englische Monatsnamen
r.Replace "January", 1
r.Replace "February", 2
r.Replace "March", 3
r.Replace "May", 5
r.Replace "June", 6
r.Replace "July", 7
r.Replace "October", 10
r.Replace "December", 12

'macht aus dem Text ein Datumsformat
For Each c In ActiveSheet.UsedRange.Columns
If Not Intersect(c, r) Is Nothing Then
For i = 1 To Cells(c.Rows.Count, c.Column).End(xlUp).Row
If IsDate(Cells(i, 1)) Then Cells(i, 1) = CDate(Cells(i, 1))
Next i
End If
Next c

Falls du mit Option explicit arbeitest, vergiss nicht am Anfang auch r as Range zu dimensionieren.
Ansonsten hoffe ich, dass ich dich endlich wieder Happy machen konnte.

L.G. Mr. K.

Answer 9

Stelle grade fest, dass noch ein kleiner Bug drin ist.

So ist der zu Ersatz-Code richtig.

Set r = Range("F:F,N:N,AG:AG,AI:AI,AJ:AJ,AM:AM")
r.NumberFormat = "dd. mmm yyyy"

'ersetzt englische Monatsnamen
r.Replace "January", "Januar"
r.Replace "February", "Februar"
r.Replace "March", "März"
r.Replace "May", "Mai"
r.Replace "June", "Juni"
r.Replace "July", "Juli"
r.Replace "October", "Oktober"
r.Replace "December", "Dezember"
'macht aus dem Text ein Datumsformat
For Each c In ActiveSheet.Columns
If Not Intersect(c, r) Is Nothing Then
For i = 1 To Cells(c.Rows.Count, c.Column).End(xlUp).Row
If IsDate(c.Cells(i, 1)) Then c.Cells(i, 1) = CDate(c.Cells(i, 1))
Next i
End If
Next c