Textdateien Spaltenweise

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von vba-noob111.

    Textdateien Spaltenweise

    Hallo zusammen,

    Ich würde gerne viele Textdateien (Endung: ".mer") spaltenweise in Excel einlesen.

    ich habe mir einen Code zusammengebastelt allerdings werden die Dateien dort Zeile für Zeile eingefügt.

    Was müsste ich ändern, um die Dateien nebeneinander in Spalten zu erhalten.

    Hier der Code
    Sub ImportText()
    '
    ' ImportText Makro
    Dim Pfad, Datei
    Dim QueryTab As QueryTable, varSource
    Dim wks As Worksheet
    '
    Pfad = "C:\Users\\"
    ' Pfad = "C:\users\Public\Test\Archiv\"
    Dim ZelleZiel As Range

    Datei = Dir(Pfad & "*.mer")

    Set wks = ActiveSheet

    Set ZelleZiel = wks.Range("A1") '1. Einfügezelle

    Do Until Datei = ""

    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & Pfad & Datei, Destination:=ZelleZiel)
    .Name = Left(Datei, Len(Datei) - 4)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = False
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 1, 1, 1, 1)
    .Refresh BackgroundQuery:=False
    varSource = .Connection
    End With

    'Verbindung der Text-Abfrage wieder löschen
    varSource = Mid(varSource, 6)
    varSource = Left(varSource, Len(varSource) - 4)
    varSource = Mid(varSource, InStrRev(varSource, "\") + 1)
    ThisWorkbook.Connections(varSource).Delete

    'Nächste Zielzelle
    With wks
    Set ZelleZiel = .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
    End With
    Datei = Dir
    Loop
    End Sub

    Danke im Voraus,
    LG :)

    Wenn Du schon fremden Code hernimmst, dann nenn bitte auch die Quelle. Sonst gehen wir davon aus, dass Du schon sehr viel kannst und geben Dir Tipps, die aber effektiv über Deinem Wissenstand sind. Vermutete Quelle: herber.de

    Du musst die Anfangszielzelle richtig setzen. Ich würd Dir ja die passende Codezeile nennen, aber dazu wäre es nötig, dass Du Deinen Beitrag editierst und CodeTags verwendest
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Hallo,

    Ja den Code habe ich gefunden bei herber.de und angepasst.

    Quellcode

    1. Sub ImportText()
    2. '
    3. ' ImportText Makro
    4. Dim Pfad, Datei
    5. Dim QueryTab As QueryTable, varSource
    6. Dim wks As Worksheet
    7. '
    8. Pfad = "C:\Users\\"
    9. ' Pfad = "C:\users\Public\Test\Archiv\"
    10. Dim ZelleZiel As Range
    12. Datei = Dir(Pfad & "*.mer")
    14. Set wks = ActiveSheet
    16. Set ZelleZiel = wks.Range("A1") '1. Einfügezelle
    18. Do Until Datei = ""
    20. With ActiveSheet.QueryTables.Add(Connection:= _
    21. "TEXT;" & Pfad & Datei, Destination:=ZelleZiel)
    22. .Name = Left(Datei, Len(Datei) - 4)
    23. .FieldNames = True
    24. .RowNumbers = False
    25. .FillAdjacentFormulas = False
    26. .PreserveFormatting = True
    27. .RefreshOnFileOpen = False
    28. .RefreshStyle = xlInsertDeleteCells
    29. .SavePassword = False
    30. .SaveData = False
    31. .AdjustColumnWidth = True
    32. .RefreshPeriod = 0
    33. .TextFilePromptOnRefresh = False
    34. .TextFilePlatform = 1252
    35. .TextFileStartRow = 1
    36. .TextFileParseType = xlDelimited
    37. .TextFileTextQualifier = xlTextQualifierDoubleQuote
    38. .TextFileConsecutiveDelimiter = False
    39. .TextFileTabDelimiter = False
    40. .TextFileSemicolonDelimiter = True
    41. .TextFileCommaDelimiter = False
    42. .TextFileSpaceDelimiter = False
    43. .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 1, 1, 1, 1)
    44. .Refresh BackgroundQuery:=False
    45. varSource = .Connection
    46. End With
    48. 'Verbindung der Text-Abfrage wieder löschen
    49. varSource = Mid(varSource, 6)
    50. varSource = Left(varSource, Len(varSource) - 4)
    51. varSource = Mid(varSource, InStrRev(varSource, "\") + 1)
    52. ThisWorkbook.Connections(varSource).Delete
    54. 'Nächste Zielzelle
    55. With wks
    56. Set ZelleZiel = .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
    57. End With
    58. Datei = Dir
    59. Loop
    60. End Sub

Facebook
Telefonspende