Erstellen einzelner .txt Dateien aus einer Excel Liste + Namensvergebung

Hallo zusammen,

ich versuche aus einer Excel Tabelle jede Zeile als einzelne .txt Datei auszugeben.
Das klappt bisher ganz gut und es werden mir alle Dateien erstellt.
Kann ich diese auch automatisch so ausgeben, dass sie als Dateinamen den jeweiligen Wert der Spalte A tragen?
In der .txt soll dann nur der Wert der Spalte B stehen wie bisher.

Beispiel:

Der Code:

Sub ErstelleDateien()
Ziel = "D:\Dein Ordner"  
Stellen = 3
Typ = ".txt"  
AbZeile = 1
Spalte = "B"  

Zeile = AbZeile
Nr = 1000001

Set fso = CreateObject("Scripting.FileSystemObject")  
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"  

Do While Cells(Zeile, Spalte).Value <> ""  
    fso.CreateTextFile(Ziel & Right(Nr, Stellen) & Typ).Write Cells(Zeile, Spalte).Value
    Zeile = Zeile + 1
    Nr = Nr + 1
Loop
End Sub

Viele Grüße
Rinberger

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 487937

Url: https://administrator.de/forum/erstellen-einzelner-txt-dateien-aus-einer-excel-liste-namensvergebung-487937.html

Ausgedruckt am: 18.04.2025 um 23:04 Uhr

10 Kommentare

Neuester Kommentar

Kann ich diese auch automatisch so ausgeben, dass sie als Dateinamen den jeweiligen Wert der Spalte A tragen?

Ja, Zeile so ändern das das Right(Nr, Stellen) geändert wird in Cells(Zeile, A)

fso.CreateTextFile(Ziel & Cells(Zeile, "A") & Typ,true).Write Cells(Zeile, Spalte).Value  

Hi vielen Dank jetzt kommt allerdings diese Meldung.

Mit F8 schrittweise durchlaufen oder Breakpoint setzen.

Wenn die Datei schon existiert, zweiten Parameter von CreateTextfile auf True setzen, s. oben .
http://www.herber.de/mailing/vb/html/vamthcreatetextfile.htm

Klappt noch nicht so.. bin da leider Anfänger. Mit F8 komme ich bis zu Zeile 16.

Sub ErstelleDateien()
Ziel = "D:\Test"  
Stellen = 3
Typ = ".txt"  
AbZeile = 1
Spalte = "B"  

Zeile = AbZeile
Nr = 1000001

Set fso = CreateObject("Scripting.FileSystemObject")  
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"  

Do While Cells(Zeile, Spalte).Value <> ""  
    Set fs = CreateObject("Scripting.FileSystemObject")  
    fso.CreateTextFile(Ziel & Cells(Zeile, A) & Typ, True).Write Cells(Zeile, Spalte).Value
    Zeile = Zeile + 1
    Nr = Nr + 1
    
Loop
End Sub

Sub ErstelleDateien()
Ziel = "D:\Test"  
Stellen = 3
Typ = ".txt"  
AbZeile = 1
Spalte = "B"  
Zeile = AbZeile

Set fso = CreateObject("Scripting.FileSystemObject")  
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"  

Do While Cells(Zeile, Spalte).Value <> ""  
    fso.OpenTextFile((Ziel & Cells(Zeile, "A").Value & Typ),2,True).Write Cells(Zeile, Spalte).Value  
    Zeile = Zeile + 1
Loop
End Sub

Strings in Zelle A müssen natürlich Dateinamenstandards erfüllen und dürfen keine Sonderzeichen die ungültig sind enthalten! Klappt hier .

Sonderzeichen wurden entfernt, keine Klammern, Punkte, Leerschritte etc. trotzdem kommt der Laufzeitfehler, woran liegt das?

Sub ErstelleDateien()
Ziel = "D:\Test"  
Stellen = 3
Typ = ".txt"  
AbZeile = 1
Spalte = "B"  
Zeile = AbZeile

Set fso = CreateObject("Scripting.FileSystemObject")  
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"  

Do While Cells(Zeile, Spalte).Value <> ""  
fso.OpenTextFile((Ziel & Cells(Zeile, A).Value & Typ), 2, True).Write Cells(Zeile, Spalte).Value
Zeile = Zeile + 1
Loop
End Sub