Microsoft Excel

Herbers Excel/VBA-Archiv

TXT Dateien einlesen


Betrifft: TXT Dateien einlesen von: Manfred
Geschrieben am: 01.08.2017 16:01:13

Hallo zusammen,

habe mal wieder ein Problem.

Ist es möglich mehrere Txt.Dateien mit „Application.GetOpenFilename“ in einen vorgegebenen Excelbereich einzulesen ? Ab A1 oder B2

Aus der txt.Datei sollen nur bestimmte Zeilen 5, 85, 86, 87 usw. eingelesen und in die Spalten geschrieben werden.

Bei TAB’s soll gesplitet werden.

Ich hatte solch ein Makro im Forum schon gefunden aber jetzt finde ich es nicht mehr.

Kennt sich da jemand aus ?

Mit freundlichen Grüßen
Manfred

  

Betrifft: AW: TXT Dateien einlesen von: Sepp
Geschrieben am: 01.08.2017 21:38:13

Hallo Mafred,

ein Beispiel.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importTextFiles()
Dim vntItem As Variant, rng As Range
Dim vntFiles() As String, vntValues() As Variant
Dim lngI As Long, lngN As Long, lngRow As Long
Dim strTemp As String
Dim ff As Integer

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum" 'Startverzeichnis
  .Title = "Dateien auswählen"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .FilterIndex = 1
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For lngI = 0 To UBound(vntFiles)
    lngRow = 0
    ff = FreeFile
    Open vntFiles(lngI) For Input As #ff
    Do While Not EOF(ff)
      lngRow = lngRow + 1
      Line Input #ff, strTemp
      Select Case lngRow
        Case 5, 15, 46, 84, 97 'Zeilen die importiert werden
          Redim Preserve vntValues(lngN)
          vntValues(lngN) = strTemp
          lngN = lngN + 1
        Case Else
      End Select
    Loop
    Close #ff
  Next
End If

If lngN > 0 Then
  Set rng = ThisWorkbook.Sheets("Tabelle1").Range("A2").Resize(lngN, 1) 'Ausgabezelle
  rng = Application.Transpose(vntValues)
  rng.TextToColumns Destination:=rng.Cells(1, 1), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False
End If

Set rng = Nothing
End Sub


Gruß Sepp



  

Betrifft: AW: TXT Dateien einlesen von: Manfred
Geschrieben am: 02.08.2017 08:45:49

Hallo Sepp,

vielen Dank für das Makro, es funzt.

Wäre es möglich den Dateinamen.txt von jeder eingelesen Datei als Überschrift zu setzen ?

Mit freundlichen Grüßen
Manfred


  

Betrifft: AW: TXT Dateien einlesen von: Rudi Maintaire
Geschrieben am: 02.08.2017 12:38:42

Hallo,
sollte so gehen:

If lngI > 0 Then
  For lngI = 0 To UBound(vntFiles)
    Redim Preserve vntValues(lngN)
    vntValues(lngN) = vntFiles(lngI)
    lngN = lngN + 1
    lngRow = 0
    ff = FreeFile
    Open vntFiles(lngI) For Input As #ff
    Do While Not EOF(ff)
      lngRow = lngRow + 1
      Line Input #ff, strTemp
      Select Case lngRow
        Case 5, 15, 46, 84, 97 'Zeilen die importiert werden
          Redim Preserve vntValues(lngN)
          vntValues(lngN) = strTemp
          lngN = lngN + 1
        Case Else
      End Select
    Loop
    Close #ff
  Next
End If
Gruß
Rudi


  

Betrifft: AW: TXT Dateien einlesen von: Manfred
Geschrieben am: 02.08.2017 13:15:30

Hallo Rudi,

es funzt, geht es auch ohne Pfadangabe ? Nur Dateiname.txt

Mit freundlichen Grüßen
Manfred


  

Betrifft: AW: TXT Dateien einlesen von: Rudi Maintaire
Geschrieben am: 02.08.2017 14:16:55

ja klar geht das.

vntValues(lngN) = Right(vntFiles(lngI), len(vntfiles(lngi))-instrrev(vntfiles(lngi),"\))
oder
vntValues(lngN)= split(vntfiles(lngI),"\)(ubound(split(vntfiles(lngI),"\)))

Gruß
Rudi


  

Betrifft: AW: TXT Dateien einlesen von: Manfred
Geschrieben am: 02.08.2017 16:09:57

Hallo Rudi,

beide Lösungen erzeugen eine Fehlermeldung. Ausdruck erwartet.

Was muss ich dafür ersetzen ?

Mit freundlichen Grüßen
Manfred


  

Betrifft: AW: TXT Dateien einlesen von: Sepp
Geschrieben am: 02.08.2017 18:31:58

Hallo Manfred,

die Fehlenden "" hätten dir aber schon selber auffallen können!


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importTextFiles()
Dim vntItem As Variant, rng As Range
Dim vntFiles() As String, vntValues() As Variant
Dim lngI As Long, lngN As Long, lngRow As Long
Dim strTemp As String
Dim ff As Integer

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum" 'Startverzeichnis
  .Title = "Dateien auswählen"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .FilterIndex = 1
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For lngI = 0 To UBound(vntFiles)
    Redim Preserve vntValues(lngN)
    vntValues(lngN) = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    lngN = lngN + 1
    lngRow = 0
    ff = FreeFile
    Open vntFiles(lngI) For Input As #ff
    Do While Not EOF(ff)
      lngRow = lngRow + 1
      Line Input #ff, strTemp
      Select Case lngRow
        Case 5, 15, 46, 84, 97 'Zeilen die importiert werden
          Redim Preserve vntValues(lngN)
          vntValues(lngN) = strTemp
          lngN = lngN + 1
        Case Else
      End Select
    Loop
    Close #ff
  Next
End If

If lngN > 0 Then
  Set rng = ThisWorkbook.Sheets("Tabelle1").Range("A2").Resize(lngN, 1) 'Ausgabezelle
  rng = Application.Transpose(vntValues)
  rng.TextToColumns Destination:=rng.Cells(1, 1), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False
End If

Set rng = Nothing
End Sub

Gruß Sepp



  

Betrifft: AW: TXT Dateien einlesen von: Manfred
Geschrieben am: 04.08.2017 08:30:37

Hallo Sepp,

sorry bin erst wieder heute da.

Das Makro funzt suupper.

Recht herzlichen Dank. Auch an Rudi.

MfG
Manfred


Beiträge aus den Excel-Beispielen zum Thema "TXT Dateien einlesen"