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
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 167543
Url: https://administrator.de/contentid/167543
Ausgedruckt am: 25.11.2024 um 19:11 Uhr
4 Kommentare
Neuester Kommentar
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
