csv export per vba
22.10.2020 06:32:08
Mike
ich habe hier im Forum einen Post gefunden, der bis auf eine Kleinigkeit bei mir gut passt.
CSV-Export per VBA (bestimmter Bereich) - von Michael (der Alte) am 23.02.2017 16:58:45
Leider kann ich darauf nicht antworten, sodass ich einen neuen Beitrag aufmachen muss.
In diesem Post wird ein CSV mit bestimmten Namen und Pfad erzeugt.
Der Name ist gut, den Pfad würde ich gerne dahingehend ändern, dass er das CSV im gleichen Verzeichnis speichert wie die original Datei.
Option Explicit
Function CSV_Erzeugen(blatt, Spalten$, Pfad$, t1$, t2$) As String
Dim aSp ' = as variant als Array
Dim z&, s&, st$, maxZ& ' & = as long z wie Zeile, $ = as string,
' s wie string für Ausgabe
Dim d As Integer ' d wie Dateinummer
On Error GoTo fehler
With Sheets(blatt)
aSp = Intersect(.Range(Spalten), .UsedRange)
End With
maxZ = UBound(aSp)
For z = 1 To maxZ
If aSp(z, 1) "" Then
For s = 1 To UBound(aSp, 2) - 1
st = st & aSp(z, s) & t2
Next
st = st & aSp(z, s) & t1
End If
Next
' statt For-Schleife kannst Du auch mal join() testen
d = FreeFile
Open Pfad For Output As #1
Print #1, st
Close #1
fehler:
If Err.Number 0 Then CSV_Erzeugen = Err.Description Else CSV_Erzeugen = "ok"
End Function
Sub aufruf()
Dim Pfad$, Ergebnis$
Pfad = "C:\DeinPfad\DateiName_" & Format(Date, "YYYYMMDD") & _
"_" & Format(Time, "hhmmss") & ".csv"
'If Dir(Pfad) = "" Then
' Ergebnis = CSV_Erzeugen("Tabelle1", "A1", Pfad, vbCrLf,";")
' If Ergebnis = "ok" Then
' MsgBox "Datei " & Pfad & " wurde erzeugt"
' Else
' MsgBox "Fehler: " & Ergebnis
' End If
' Else
' MsgBox "Datei bereits vorhanden"
'End If
' *** oder ganz einfach:
MsgBox CSV_Erzeugen("Tabelle2", "A:P", Pfad, vbCrLf, ";")
' Trennen z.B. mit: vblf, vbcr oder vbcrlf
End Sub
vg
Mike