Exelblatt als txt exportieren

Hallo liebe Exel Experten,
mein Ziel ist es aus einer Exelmappe (xlsm-Format) mit mehreren Arbeitsblättern, das gerade aktivierte als txt-Datei mit Tabstop Trennung zu exportieren. Da ich mich mit VBA nicht wirklich gut auskenne, habe ich ein anderes Makro als Vorlage genommen, welches wunderbar funktioniert und es versucht etwas umzubauen.
Das Original speichert die komplette Exelmappe mit Makros unter einem anderen Namen,(aber dem selben Pfad wie das Original) der sich aus dem Inhalt einer Zelle ergibt und wechselt dann auf das erste Blatt, der soeben gespeicherten Datei.

Sub DIFF_export()
ActiveSheet.SaveAs ThisWorkbook.Path & "\" & Range("E10"), FileFormat:=xlText
' ermittelt den pfad der aktuell geöffneten Datei und fügt den neuen Namen hinzu und  _
speichert als txt
ActiveWorkbook.Sheets(1).Select
Range("E4").Select
' geht zurück zu der Tabelle aus der heraus gespeichert wird
MsgBox "Die Überstunden wurde gespeichert unter dem Name:" & vbLf & vbLf & Sheets("Export"). _
_
_
Range("E10").Text & vbLf & vbLf & "Datei kann im nächsten Monat importiert werden.", , " _
Speichern erfolgreich"
' Gibt ein Fenster aus, in dem nochmal der Erfolg und der Dateiname bestätigt werden
End Sub

In der Zelle E10 des Blattes steht zum Beispiel "Diff_05_2013.txt", die soll der Dateiname sein. Ich habe zuerst den Makrorecorder laufen lassen und das Blatt als txt abgespeichert. Da kam folgendes heraus:
ChDir "E:\Eigene Dateien\mein Pfad"
ActiveWorkbook.SaveAs Filename:= _
"E:\Eigene Dateien\Eigene Dokumente\mein Pfad\Dplan Vorlage.txt", _
FileFormat:=xlText, CreateBackup:=False
Daraufhin habe ich mit dem FileFormat:=xtText experimentiert, aber es klappt nicht. Momentan gibt es immer einen 1004 Laufzeitfehler. Weiterhin möchte ich nicht das die erzeugte txt-Datei geöffnet wird, sondern das ich wieder auf dem Blatt lande, aus dem ich vorher exportiert habe.
Vielen dank im Voraus für Eure Hilfe
Bubble

Hallo,
kannst mal diese Variante versuchen bzw. testen.

Sub Test_Schreibe_TxT()
Dim sPath$, strZeile$
Dim ArrayData, rngRange As Range, booErste As Boolean
Dim F%

Const strTrennzeichen$ = vbTab

sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
With ActiveSheet
    'Name der TxT-Datei prüfen 
    If .Range("E10").Value = "" Then Exit Sub
    If Not LCase(.Range("E10").Value) Like "*.txt" Then Exit Sub
    'kopletter Pfad 
    sPath = sPath & .Range("E10").Value
    'prüfen ob schon vorhanden --> löschen 
    If Dir(sPath, vbNormal) <> "" Then Kill sPath
    'Datei zum anhängen von Daten öffnen 
    F = FreeFile
    Open sPath For Append As #F
    'Bereich in Tabelle Feststellen 
    Set rngRange = Range("A1", FindLetzte(Sheets(.Name)))
    'Bereich Zeilen für Zeile durchlaufen 
    For Each rngRange In rngRange.Rows
        'Zeile in Array Transponieren 
        ArrayData = Application.Transpose(rngRange)
        'Array Transponieren und als Text verketten 
        ArrayData = Join(Application.Transpose(ArrayData), strTrennzeichen)
        'erst ab erster Zeile mit Inhalt schreiben 
        If Not booErste Then booErste = Replace(ArrayData, strTrennzeichen, "") <> ""
        If booErste Then
            Print #F, ArrayData
        End If
    Next rngRange
    
    Close #F
End With
End Sub

Function FindLetzte(mySH As Worksheet) As Range
Dim LRow As Long, LCol As Long
Dim A As Long
 
 With mySH.UsedRange
   On Error Resume Next
        'Finde Zeile 
        LRow = .Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False).Row
        LRow = Application.Max(LRow, .Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row)
        If LRow = 0 Then LRow = 1
   
        'Finde Spalte 
        For A = .Columns(.Columns.Count).Column To .Columns(1).Column Step -1
              LCol = mySH.Columns(A).Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Column
              LCol = Application.Max(LCol, mySH.Columns(A).Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Column)
              If LCol > 1 Then: LCol = A: Exit For
        Next A
        If LCol = 0 Then LCol = 1
 End With
 
 Set FindLetzte = mySH.Cells(LRow, LCol)
End Function

Gruß Tino

Forumthread: Exelblatt als txt exportieren

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Excel-Blatt als TXT exportieren

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)