4
Spalte zeilenweise als Dateien rausschreiben und Dateinamen nach Excel zurückschreiben
Hallo,
mit diverser Hilfe aus diesem Forum habe ich ein Makro geschrieben, das mir den Inhalt der Spalte "E" zeilenweise ab der 2. Zeile als Textdateien herausschreibt und die Dateinamen 5-stellig fortlaufend durchnummeriert. Das funktioniert soweit ganz gut.
Nun möchte ich das Makro dermaßen erweitern, dass die erzeugten Dateinamen zusätzlich in eine leere Spalte ins Excelblatt zurückgeschrieben werden.
Der Spaltentitel sollte auch gleich mit eingesetzt werden. Dabei soll berücksichtigt sein, dass, wenn ab Zeile 2 exportiert wurde, auch erst ab Zeile 2 wieder die Dateinamen zurückgeschrieben werden.
Es soll also der entsprechende Dateiname in seinem zugehörigen Datensatz platziert werden.
Da meine VBA-Kenntnisse noch recht bescheiden sind, bin ich um Eure Hilfe dankbar.
(Arbeite mit Excel 2007 unter Win7)
Gruß
Yosimo
mit diverser Hilfe aus diesem Forum habe ich ein Makro geschrieben, das mir den Inhalt der Spalte "E" zeilenweise ab der 2. Zeile als Textdateien herausschreibt und die Dateinamen 5-stellig fortlaufend durchnummeriert. Das funktioniert soweit ganz gut.
Sub ExportiereSpalte(control As IRibbonControl)
Ziel = ActiveWorkbook.Path & "\"
Stellen = 5
Typ = ".txt"
AbZeile = 2
Spalte = "E"
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 SubNun möchte ich das Makro dermaßen erweitern, dass die erzeugten Dateinamen zusätzlich in eine leere Spalte ins Excelblatt zurückgeschrieben werden.
Der Spaltentitel sollte auch gleich mit eingesetzt werden. Dabei soll berücksichtigt sein, dass, wenn ab Zeile 2 exportiert wurde, auch erst ab Zeile 2 wieder die Dateinamen zurückgeschrieben werden.
Es soll also der entsprechende Dateiname in seinem zugehörigen Datensatz platziert werden.
Da meine VBA-Kenntnisse noch recht bescheiden sind, bin ich um Eure Hilfe dankbar.
(Arbeite mit Excel 2007 unter Win7)
Gruß
Yosimo
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 167543
Url: https://administrator.de/contentid/167543
Printed on: April 20, 2024 at 02:04 o'clock
4 Comments
Latest comment
Hallo Yosimo!
Etwa so:
Falls Du mit "Spaltentitel" eine Spaltenüberschrift unmittelbar vor der ersten Datenzeile meinst, dann kannst Du dafür folgende Zeile 8 verwenden:
Grüße
bastla
Etwa so:
Sub ExportiereSpalte(control As IRibbonControl)
Ziel = ActiveWorkbook.Path & "\"
Stellen = 5
Typ = ".txt"
AbZeile = 2
Spalte = "E"
SpalteNamen = "H"
Zeile = AbZeile
Nr = 1000001
Set fso = CreateObject("Scripting.FileSystemObject")
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"
Do While Cells(Zeile, Spalte).Value <> ""
Dateiname = Ziel & Right(Nr, Stellen) & Typ
fso.CreateTextFile(Dateiname).Write Cells(Zeile, Spalte).Value
Cells(Zeile, SpalteNamen).Value = Dateiname
Zeile = Zeile + 1
Nr = Nr + 1
Loop
End SubIf AbZeile >= 2 Then Cells(AbZeile - 1, SpalteNamen).Value = "Spaltentitel"
bastla
Hallo bastla,
funktioniert prima, vielen Dank!
Den ganzen Pfadnamen brauche ich jedoch nicht in der Excelzelle, nur den Dateinamen.
Und die Spaltenüberschrift soll immer in der ersten Zelle stehen (was bei "AbZeile = 2" ja automatisch der Fall ist).
Ich hab's dahingehend geändert:
Damit ist das Wichtigste vorerst erledigt, alles weitere ist jetzt nur noch Kosmetik (Input- u. Messageboxen, Sanduhr usw.).
Gruß und Dank
Yosimo
funktioniert prima, vielen Dank!
Den ganzen Pfadnamen brauche ich jedoch nicht in der Excelzelle, nur den Dateinamen.
Und die Spaltenüberschrift soll immer in der ersten Zelle stehen (was bei "AbZeile = 2" ja automatisch der Fall ist).
Ich hab's dahingehend geändert:
Sub ExportiereSpalte(control As IRibbonControl)
Ziel = ActiveWorkbook.Path & "\"
Stellen = 5
Typ = ".txt"
AbZeile = 2
Spalte = "E"
SpalteNamen = "H"
Cells(1, SpalteNamen).Value = "Spaltentitel" '<---------- HIER GEÄNDERT
Zeile = AbZeile
Nr = 1000001
Set fso = CreateObject("Scripting.FileSystemObject")
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"
Do While Cells(Zeile, Spalte).Value <> ""
Dateiname = Ziel & Right(Nr, Stellen) & Typ
DateinameZelle = Right(Nr, Stellen) & Typ '<----------HIER ERGÄNZT
fso.CreateTextFile(Dateiname).Write Cells(Zeile, Spalte).Value
Cells(Zeile, SpalteNamen).Value = DateinameZelle '<---------- HIER GEÄNDERT
Zeile = Zeile + 1
Nr = Nr + 1
Loop
End SubDamit ist das Wichtigste vorerst erledigt, alles weitere ist jetzt nur noch Kosmetik (Input- u. Messageboxen, Sanduhr usw.).
Gruß und Dank
Yosimo
Hallo Yosimo!
Noch eine Kleinigkeit: In den Zeilen 17 und 18 wird zweimal (gleich) der eigentliche Dateiname zusammengesetzt - das ließe sich so umstellen (und damit etwas änderungs-/wartungsfreundlicher machen):
Ich wollte nicht auch noch die Variablennamen verändern, aber "Dateiname" und "Dateipfad" würden mir besser gefallen ...
Grüße
bastla
Noch eine Kleinigkeit: In den Zeilen 17 und 18 wird zweimal (gleich) der eigentliche Dateiname zusammengesetzt - das ließe sich so umstellen (und damit etwas änderungs-/wartungsfreundlicher machen):
DateinameZelle = Right(Nr, Stellen) & Typ '<----------HIER ERGÄNZT
Dateiname = Ziel & DateinameZelleGrüße
bastla
Hallo bastla,
Danke für die Hinweise - habe es angepasst.
Gruß
Yosimo
Danke für die Hinweise - habe es angepasst.
Gruß
Yosimo
