VBA Excel zu Textdatei und speichern nicht überschreiben

Hallo zusammen,

ich denke mal es gibt sicher eine nette Lösung.

Wenn ich auf den Button klicke speichert er mir ja korrekterweise alles in April.txt.
Wenn man nun ein 2. mal draufklickt überschreibt er mit die Daten.

Gibt es einen Lösungsweg den ich grad nicht sehe ?

Danke schonmal und nochmals für Eure Hilfe

Option Explicit

Sub April()

'Variablen definieren
Dim Zieldatei As String 'SpeicherOrt der TextDatei
Dim Zeile As Integer 'Schleifenvariable

'FehlerMarke einfügen
On Error GoTo FehlerMarke

'Tabellenblatt aktivieren
ThisWorkbook.Worksheets("April").Activate

'Zieldatei erstellen
Zieldatei = ThisWorkbook.Path & "\April.txt"

'Zieldatei öffnen
Open Zieldatei For Output As #1

'Informationen in die ZielDatei einfügen
For Zeile = 2 To 31

' Werte aus der Tabelle in das Txt eintragen
Print #1, Right(Cells(Zeile, 2).Text, 10) & " " & _
Left(Cells(Zeile, 5).Text, 10) & " " & _
Right(Cells(Zeile, 6).Text, 10) & " " & _
Left(Cells(Zeile, 8).Text, 10)

Next Zeile

'Zieldatei schließen
Close #1

Exit Sub
FehlerMarke:
MsgBox Err.Description

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich habe es jetzt mal ganz anders gelöst.

Aber dennoch danke für die Hilfe, Gruß

Sub ExportToText()

    Dim filePath As String

    Dim fileName As String

    Dim fileContent As String



    ' Speicherort der Excel-Datei

    filePath = ThisWorkbook.Path & "\"



    ' Name des Textdokuments (ohne Erweiterung)

    fileName = ActiveSheet.Name & "_" & Format(Now(), "dd-mm-yyyy")



    ' Inhalt der Zellen

    fileContent = ""

    For i = 2 To 31

        For j = 2 To 8

            If j > 3 And j > 4 And j > 7 Then ' Überprüfen und auschliessen

                fileContent = fileContent & Cells(i, j).Text & "   "

            End If

        Next j

        fileContent = fileContent & vbCrLf ' Neue Zeile nach jeder Zeile hinzufügen

    Next i



    ' Textdokument erstellen und Inhalt schreiben

    Open filePath & GetNextFileName(filePath, fileName) & ".txt" For Output As #1

    Print #1, fileContent

    Close #1



End Sub



Function GetNextFileName(filePath As String, fileNamePrefix As String) As String

    Dim fileNumber As Integer



    ' Prüfen, ob die Datei bereits existiert

    If Dir(filePath & fileNamePrefix & ".txt") > "" Then

        fileNumber = 1

        ' Fortlaufende Nummer hinzufügen, bis ein eindeutiger Dateiname gefunden wird

        Do While Dir(filePath & fileNamePrefix & "_" & fileNumber & ".txt") > ""

            fileNumber = fileNumber + 1

        Loop

        GetNextFileName = fileNamePrefix & "_" & fileNumber

    Else

        GetNextFileName = fileNamePrefix

    End If



End Function

Beliebteste Forumthreads (12 Monate)

VBA Excel zu Textdatei und speichern nicht überschreiben

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Excel zu Textdatei und speichern nicht überschreiben

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread