Excel Zeilen als einzelne Text-Dateien

Hallo,
ich habe im Archiv ein Makro gefunden, welches jede Zeile in jeweils eine txt-Datei schreibt.
https://www.herber.de/forum/archiv/1596to1600/1597522_Excel_Zeilen_als_einzelne_TextDateien_speichern.html#1597567


' Modul: Modul1 Typ: Allgemeines Modul
Option Explicit
Sub ErstelleDateien()
Dim strPath As String, strText As String, strDivider As String, strFileName As String
Dim lngRow As Long, lngStartRow As Long, lngLastRow As Long
Dim lngCol As Long, lngStartCol As Long, lngLastCol As Long
Dim FF As Integer
strPath = "C:\Users\Robert\Desktop\Skriptcode" 'Zielpfad
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strDivider = ";" 'Trennzeichen der Textdatei - Anpassen
lngStartRow = 4 'Erste Zeile mit Daten
lngStartCol = 3 'Erste Spalte (Dateiname)
With Sheets("Speichern der Datei1") 'Tabellenname - Anpassen
lngLastRow = Application.Max(lngStartRow, .Cells(.Rows.Count, 4).End(xlUp).Row) 'letzte Zeile
lngLastCol = Application.Max(lngStartCol, .Cells(lngStartRow, .Columns.Count).End(xlToLeft). _
Column) 'letzte Spalte
For lngRow = lngStartRow To lngLastRow
strFileName = strPath & .Cells(lngRow, lngStartCol) & ".txt"
strText = ""
For lngCol = lngStartCol + 1 To lngLastCol
strText = strText & .Cells(lngRow, lngCol) & strDivider
Next
strText = Left(strText, Len(strText) - Len(strDivider))
FF = FreeFile
Open strFileName For Output As #FF
Print #FF, strText
Close #FF
Next
End With
End Sub
Gruß Sepp

Habe es für meine Bedürfnisse angepasst.
Allerdings möchte ich, dass in der txt-Datei den Inhalt jeder Zelle in "XXXX" Anführungszeichen steht.
Z.B. "abcdefg";"hijklmn";"opqrstuv"
Das habe ich leider nicht hinbekommen.
Kann mir da bitte jemand helfen?
Vielen Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marco,
teste mal:

Option Explicit

Public Sub ErstelleDateien()
    Dim strPath As String, strText As String, strDivider As String, strFileName As String
    Dim lngRow As Long, lngStartRow As Long, lngLastRow As Long
    Dim lngCol As Long, lngStartCol As Long, lngLastCol As Long
    Dim FF As Integer


    strPath = "H:\" ' "C:\Users\Robert\Desktop\Skriptcode" 'Zielpfad

    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

    strDivider = Chr$(34) & ";" & Chr$(34) 'Trennzeichen der Textdatei - Anpassen

    lngStartRow = 4 'Erste Zeile mit Daten

    lngStartCol = 3 'Erste Spalte (Dateiname)

    With Sheets("Speichern der Datei1") 'Tabellenname - Anpassen
        lngLastRow = Application.Max(lngStartRow, .Cells(.Rows.Count, 4).End(xlUp).Row) 'letzte Zeile
        lngLastCol = Application.Max(lngStartCol, .Cells(lngStartRow, .Columns.Count).End(xlToLeft).Column) 'letzte Spalte
        For lngRow = lngStartRow To lngLastRow
            strFileName = strPath & .Cells(lngRow, lngStartCol) & ".txt"
            strText = ""
            For lngCol = lngStartCol + 1 To lngLastCol
                strText = strText & .Cells(lngRow, lngCol) & strDivider
            Next
            strText = Chr$(34) & Left(strText, Len(strText) - Len(strDivider) + 1)
            FF = FreeFile
            Open strFileName For Output As #FF
            Print #FF, strText
            Close #FF
        Next
    End With

End Sub

Gruß
Nepumuk

' Modul: Modul1 Typ: Allgemeines Modul ' Jede Zeile wird in eine einzelne Txt-Datei geschrieben und ' gespeichert. Dateiname ist jeweils der Inhalt in der ersten Spalte ' Das Trennzeichen kann angepasst werden. Option Explicit Sub ErstelleDateien() Dim strPath As String, strText As String, strDivider As String, strFileName As String Dim lngRow As Long, lngStartRow As Long, lngLastRow As Long Dim lngCol As Long, lngStartCol As Long, lngLastCol As Long Dim FF As Integer strPath = "C:\Temp\Import" 'Zielpfad If Right(strPath, 1) "\" Then strPath = strPath & "\" strDivider = ";" 'Trennzeichen der Textdatei - Anpassen lngStartRow = 1 'Erste Zeile mit Daten lngStartCol = 1 'Erste Spalte (Dateiname) With Sheets("Daten für Nav zum importieren") 'Tabellenname - Anpassen lngLastRow = Application.Max(lngStartRow, .Cells(.Rows.Count, 4).End(xlUp).Row) 'letzte Zeile lngLastCol = Application.Max(lngStartCol, .Cells(lngStartRow, .Columns.Count).End(xlToLeft). _ Column) 'letzte Spalte For lngRow = lngStartRow To lngLastRow strFileName = strPath & .Cells(lngRow, lngStartCol) & ".txt" strText = "" For lngCol = lngStartCol + 0 To lngLastCol + 1 strText = strText & Chr$(34) & .Cells(lngRow, lngCol) & Chr$(34) & strDivider 'Chr$(34) _ ist das Zeichen " Next strText = Left(strText, Len(strText) - Len(strDivider)) FF = FreeFile Open strFileName For Output As #FF Print #FF, strText Close #FF Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Excel Zeilen als einzelne Text-Dateien

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread