VBA – Bereich in CSV exportieren (Textdatei mit Trennzeichen)

Bereich in CSV-Datei speichern

Lösung  Nr. 670 für den Export eines Bereichs in eine Textdatei mit Trennzeichen.

Dies ist eine praktische Alternative zur Excel-Standardmethode, das Arbeitsblatt als Textdatei oder als getrennte CSV-Datei zu speichern („Speichern unter“ wählen), wenn:

1. Sie eine Vorlage verwenden und nur die Daten ohne Kopfzeilen und Sonstiges exportieren möchten

2. Sie vielleicht  auch nur einen Teil eines Datensatzes exportieren möchten

3. Sie die Datei mit einem benutzerdefinierten Trennzeichen, das für Ihre Anwendung spezifisch sein sollte, speichern möchten.

Wenn Sie 1, 2 oder 3 realisieren müssen, kann eine Funktion wie die folgende helfen. Sie akzeptiert einen zu exportierenden Bereich, den Speicherort der Datei und das Trennzeichen, mit dem die Daten getrennt werden sollen und speichert die Daten dann wie angegeben.

So rufen Sie die Funktion BereichExportieren auf:

Sub ExportierenAufrufen()

  'BereichExportieren(Bereich, Wo, Trennzeichen)
  Call BereichExportieren(Tabelle1.Range("A1:C20"), _

  "C:\mark.txt", ",")

End Sub

Zuerst teilen Sie der Funktion den Bereich mit, den Sie exportieren möchten, dann den Ort, an den er exportiert werden soll und schließlich das zu verwendende Trennzeichen. Sie brauchen auch die Funktion ExportRange, hier ist sie:

Function BereichExportieren(WelcherBereich As Range, _
         Wo As String, Trennzeichen As String) As String

  Dim HalteZeile As Long 'Test für neue Zeilenvariable
  HalteZeile = WelcherBereich.Row

  Dim c As Range

  'Bereichsvariable durchlaufen
  For Each c In WelcherBereich
    If HalteZeile <> c.Row Then
      'Zeilenumbruch hinzufügen und zusätzliche Trennzeichen entfernen
      BereichExportieren = Left(BereichExportieren, Len(BereichExportieren) - 1) _
                          & vbCrLf & c.Text & Trennzeichen
        HalteZeile = c.Row
    Else
        BereichExportieren = BereichExportieren & c.Text & Trennzeichen
    End If
Next c

'Zusätzliches Trennzeichen abschneiden
BereichExportieren = Left(BereichExportieren, Len(BereichExportieren) - 1)

'Die Datei löschen, wenn sie bereits existiert
If Len(Dir(Wo)) > 0 Then
    Kill Wo
End If

Open Where For Append As #1 'Die neue Datei beschreiben
Print #1, BereichExportieren
Close #1
End Function