Informationen und Beispiele zum Thema MsgBox | |
---|---|
![]() |
MsgBox-Seite mit Beispielarbeitsmappe aufrufen |
Hallo,
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 SubDanke schon mal für eure HIlfe.