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

Please also mark the comments that contributed to the solution of the article

Content-Key: 487937

Url: https://administrator.de/contentid/487937

Printed on: April 20, 2024 at 04:04 o'clock

10 Comments

Latest comment

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