VBA Erzeugte TXTs speichern ins Verzeichnis der Xslm

Moderator: ModerationP

VBA Erzeugte TXTs speichern ins Verzeichnis der Xslm

Beitragvon AntonK44 » 23. Okt 2021, 21:17

Hallo
leider hab ich mich nun vollends verbastelt.
Ich bin neu im Thema, 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.

Ausgangslage:
Workbook mit n Worksheets mit n Spalten und n Zeilen
Anforderung:
Worksheetinhalte sollen in jeweils separate TXTs gespeichert werden. Ausnahme: Erstes Tabellenblatt.
Name der TXTs wie Worksheets.
Zelleninhalte einer Zeile (n Spalten) als Zeile in der TXT ohne Trennzeichen.

Soweit so gut.. siehe Beispielcode.

Im Beispielcode habe ich dann den Versuch unternommen, das Verzeichnis dynamisch zu definieren. "Dorthin wo auch die Ursprungsdatei liegt"
Es hat nicht funktioniert. Irgendwie scheint er bei der Schleife bei Öffnen der Hilfsmappe (wks.Copy) diese als ActiveWorkbook zu sehen uns schließt dann unten die Ursprungs-Arbeitsmappe
Ohne diesen Versuch - also mit absoluten Verzeichnis als Speicherort - geht es. Aber so kann ich das nicht an verschiedenen Stellen einsetzen.
Der Versuch, die Schleife freizuhalten, indem ich in wkb das Ursprungs-Workbook reinspeichere, hats nicht gebracht.

Code: Alles auswählen
'Speichere alle Tabellenblätter als TXT-Files ohne Trennzeichen ab.
'Alle Spalten werden zu 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 einem 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
    strFilename = 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
AntonK44
Neuling
 
Beiträge: 2
Registriert: 23. Okt 2021, 21:00

Re: VBA Erzeugte TXTs speichern ins Verzeichnis der Xslm

Beitragvon Kuwe » 23. Okt 2021, 22:37

Hallo Anton,

hier mal ohne unnötiges Kopieren (und somit Erzeugen einer Neuen Mappe, das vermutlich vorheriger Lösungsansätze geschuldet war):

Code: Alles auswählen
    'Speichere alle Tabellenblätter als TXT-Files ohne Trennzeichen ab.
    'Alle Spalten werden zu einem Zeilen-String zusammengefügt

Sub SaveTXTwithoutDelimiter()
    Dim Bereich As Range, Zeile As Range, Zelle As Range
    Dim strFilename As String
    Dim strPath As String
    Dim strTemp As String
    Dim wkb As Workbook
    Dim wks As Worksheet
    Const Extension As String = ".txt"

    'Speichere Ursprungs-Workbook als ActiveWorkbook in wkb
    Set wkb = ActiveWorkbook
    strPath = wkb.Path & "\"
    'Auskommentierte Ersatzzeile mit einem absolutem Pfad
    'strPath = "/Users/anton/Downloads/"
    Application.ScreenUpdating = False
    For Each wks In wkb.Worksheets
        If wks.Index > 1 Then
'            wks.Copy
            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
                    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
                                                                                                               [/u]
Gruß Uwe
Benutzeravatar
Kuwe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6676
Registriert: 30. Dez 2003, 18:37

Re: VBA Erzeugte TXTs speichern ins Verzeichnis der Xslm

Beitragvon AntonK44 » 25. Okt 2021, 08:04

Hallo Uwe,
danke für den Augenöffner!

Anton
AntonK44
Neuling
 
Beiträge: 2
Registriert: 23. Okt 2021, 21:00


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast