Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1852to1856
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Erzeugte TXTs speichern

VBA Erzeugte TXTs speichern
23.10.2021 12:17:05
Anton
Hallo,
ich bin neu, mir fehlen sicher auch einige Grundlagen.. werde daran arbeiten und habe um mein Ziel zu erreichen viel im Forum gelesen und hänge an einer trivialen Stelle.
Meine Lösung wirkt sicher irgendwie ungalant und zusammengestoppelt.
Anforderung:
Workbook mit n Worksheets mit n Spalten und n Zeilen
Worksheetinhalte sollen in jeweils separate TXTs gespeichert werden. Ausnahme: Erstes Tabellenblatt.
Name der TXTs wie Worksheet.
Zelleninhalte einer Zeile (n Spalten) als Zeile in der TXT ohne Trennzeichen.
Soweit so gut.. siehe Beispielcode.
Im Beispielcode habe ich den Versuch auskommentiert, das Verzeichnis dynamisch zu definieren. "Dorthin wo auch die Ursprungsdatei liegt"
Es hat nicht funktioniert.

'Speichere alle Tabellenblätter als TXT-Files ab.
'Alle Zellen einer Zeile werden zu einem Zeilen-String OHNE Trennzeichen zusammengefügt
Sub SaveTXTwithoutDelimiter()
Dim Bereich As Range, Zeile As Range, Zelle As Range
Dim wks As Worksheet
Dim strTemp As String
Dim strFilename As String
Dim strPath As String
strPath = "/Users/antonkunze/Downloads/"
'strPath = Application.ActiveWorkbook.Path & "/"
Const Extension As String = ".txt"
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Worksheets
If wks.Index > 1 Then
wks.Copy
Set Bereich = ActiveSheet.UsedRange
dateiname = ActiveSheet.Name
Open strPath & strFilename & Extension For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
strTemp = strTemp & Zelle.Text
Next Zelle
Print #1, strTemp
strTemp = ""
Next Zeile
Close #1
Set Bereich = Nothing
ActiveWorkbook.Close SaveChanges:=False
End If
Next wks
Application.ScreenUpdating = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Erzeugte TXTs speichern
23.10.2021 12:25:55
Anton
Sorry.. vielleicht noch zu dem etwas lapidaren "es hat nicht funktioniert":
Der Schleifendurchlauf funktioniert nicht mehr. Ich vermute, es hat etwas mit ActiveWorkbook und wie ich das versuche zu verwenden zu tun, dass er unten in der Schleife plötzlich nicht das erzeugte wks.Copy zumacht, sondern die Ursprungsmappe.
AW: VBA Erzeugte TXTs speichern
23.10.2021 13:06:53
ralf_b
nach wks.copy erstellst du eine neue Mappe, mit dem kopierten Blatt. Die neue Mappe ist dann das aktive Workbook.
die Schleife könntest du so absichern, indem das Workbook in eine Variabel geschrieben wird

dim wkb as Workbook
set wkb = ActiveWorkbook
for each wks in wkb.worksheets

Anzeige
AW: VBA Erzeugte TXTs speichern
23.10.2021 20:00:03
Anton
Danke Ralf,
so etwas in der Art vermutete ich.
Mein "Absichern"-Versuch hatte nicht funktioniert. Allerdings mit Deinem Input habe ich es nicht zum Laufen bekommen. Es switcht noch immer in das Schleifen-ActiveWorkbook...
Hier der angepasste Versuch

'Speichere alle Tabellenblätter als TXT-Files ab.
'Alle Spalten werdenzu einem Zeilen-String zusammengefügt
Sub SaveTXTwithoutDelimiter()
Dim Bereich As Range, Zeile As Range, Zelle As Range
Dim wks As Worksheet
Dim strTemp As String
Dim strFilename As String
Const Extension As String = ".txt"
Dim strPath As String
strPath = Application.ActiveWorkbook.Path & "/"
'Speichere Ursprungs-Workbook als ActiveWorkbook in wkb
Dim wkb As Workbook
Set wkb = ActiveWorkbook
'Auskommentierte Ersatzzeile mit absolutem Pfad
'strPath = "/Users/anton/Downloads/"
Application.ScreenUpdating = False
For Each wks In wkb.Worksheets
If wks.Index > 1 Then
wks.Copy
Set Bereich = ActiveSheet.UsedRange
dateiname = ActiveSheet.Name
Open strPath & strFilename & Extension For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
strTemp = strTemp & Zelle.Text
Next Zelle
Print #1, strTemp
strTemp = ""
Next Zeile
Close #1
Set Bereich = Nothing
ActiveWorkbook.Close SaveChanges:=False
End If
Next wks
Application.ScreenUpdating = True
End Sub

Anzeige
AW: VBA Erzeugte TXTs speichern
23.10.2021 22:49:27
Anton
Korrektur..

dateiname = ActiveSheet.Name
... soll natürlich

strFilename = ActiveSheet.Name
heißen.
AW: VBA Erzeugte TXTs speichern
23.10.2021 23:26:55
ralf_b
das liegt wohl daran das das Activesheet auch in das neue Workbook wechselt.
Aber es wird kein copy benötigt.
probier mal.

Option Explicit
'Speichere alle Tabellenblätter als TXT-Files ab.
'Alle Spalten werdenzu einem Zeilen-String zusammengefügt
Sub SaveTXTwithoutDelimiter()
Dim Bereich As Range, Zeile As Range, Zelle As Range
Dim wks As Worksheet
Dim wkb As Workbook
Dim strTemp As String
Dim strFilename As String
Const Extension As String = ".txt"
Dim strPath As String
'Speichere Ursprungs-Workbook als ActiveWorkbook in wkb
Set wkb = ActiveWorkbook
strPath = wkb.Path & "/"  'sicher das dies ein slash sein soll und kein Backslash?
'Auskommentierte Ersatzzeile mit absolutem Pfad
'strPath = "/Users/anton/Downloads/"
Application.ScreenUpdating = False
For Each wks In wkb.Worksheets
If wks.Index > 1 Then
' wks.Copy 'wird nicht benötigt
Set Bereich = wks.UsedRange
strFilename = wks.Name
Open strPath & strFilename & Extension For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
strTemp = strTemp & " " & Zelle.Text 'auf verdacht, leerzeichen eingefügt
Next Zelle
Print #1, strTemp
strTemp = ""
Next Zeile
Close #1
Set Bereich = Nothing
'ActiveWorkbook.Close SaveChanges:=False 'unnötig
End If
Next wks
Application.ScreenUpdating = True
Set wks = Nothing: Set wkb = Nothing
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige