Excel Makro Export in eine CSV Datei
Hallo, ich möchte eine Exceltabelle mittels Makro in einen Pfad mit festem Dateinamen exportieren.
Hierzu gibt es schon folgenden Code:
Sub TestRange()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("N7")
'Bereich der exportiert wird
Set rngExport = ws.Range("A7:S45")
If rngTest.Text <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Wählen sie einen Namen unter der die CSV-Datei gespeichert werden soll"
'Filterindex für CSV-Dateien ermitteln
For i = 1 To .Filters.Count
If .Filters(i).Extensions = "vis_order.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(filepath, 2, True)
arr = rng.Value
If IsArray(arr) Then
'If arr(1, 14) <> "" Then
For r = 1 To UBound(arr, 1)
line = ""
If arr(r, 14) <> "" Then 'Wenn Inhalt in Spalte N
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & "" & arr(r, c) & "" & delim
Else
line = line & "" & arr(r, c) & ""
End If
Next
'End If
csvContent = csvContent & line & vbNewLine
End If
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
'End If
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
IN dem vorliegenden Code funktioniert das ganze schon allerdings muss beim ausführen immer der Pfad und die Datei manuell ausgewählt werden, das möchte ich automatisieren.
Kann mir hierzu noch jemand helfen ?
Vielen Dank
Hierzu gibt es schon folgenden Code:
Sub TestRange()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("N7")
'Bereich der exportiert wird
Set rngExport = ws.Range("A7:S45")
If rngTest.Text <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Wählen sie einen Namen unter der die CSV-Datei gespeichert werden soll"
'Filterindex für CSV-Dateien ermitteln
For i = 1 To .Filters.Count
If .Filters(i).Extensions = "vis_order.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(filepath, 2, True)
arr = rng.Value
If IsArray(arr) Then
'If arr(1, 14) <> "" Then
For r = 1 To UBound(arr, 1)
line = ""
If arr(r, 14) <> "" Then 'Wenn Inhalt in Spalte N
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & "" & arr(r, c) & "" & delim
Else
line = line & "" & arr(r, c) & ""
End If
Next
'End If
csvContent = csvContent & line & vbNewLine
End If
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
'End If
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
IN dem vorliegenden Code funktioniert das ganze schon allerdings muss beim ausführen immer der Pfad und die Datei manuell ausgewählt werden, das möchte ich automatisieren.
Kann mir hierzu noch jemand helfen ?
Vielen Dank
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 438387
Url: https://administrator.de/forum/excel-makro-export-in-eine-csv-datei-438387.html
Ausgedruckt am: 19.02.2025 um 22:02 Uhr
5 Kommentare
Neuester Kommentar

Er hat's immer noch nicht kapiert deswegen auch so unformatiert zurück
Sub TestRange()
Dim ws As Worksheet, rngTest As Range, rngExport as Range
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("N7")
'Bereich der exportiert wird
Set rngExport = ws.Range("A7:S45")
If rngTest.Text <> "" Then
ExportRangeAsCSV rngExport, ";", "d:\jajetztjaeineInsel.csv"
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(filepath, 2, True)
arr = rng.Value
If IsArray(arr) Then
'If arr(1, 14) <> "" Then
For r = 1 To UBound(arr, 1)
line = ""
If arr(r, 14) <> "" Then 'Wenn Inhalt in Spalte N
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & "" & arr(r, c) & "" & delim
Else
line = line & "" & arr(r, c) & ""
End If
Next
'End If
csvContent = csvContent & line & vbNewLine
End If
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
'End If
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
Sub TestRange()
Dim ws As Worksheet, rngTest As Range, rngExport as Range
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("N7")
'Bereich der exportiert wird
Set rngExport = ws.Range("A7:S45")
If rngTest.Text <> "" Then
ExportRangeAsCSV rngExport, ";", "d:\jajetztjaeineInsel.csv"
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(filepath, 2, True)
arr = rng.Value
If IsArray(arr) Then
'If arr(1, 14) <> "" Then
For r = 1 To UBound(arr, 1)
line = ""
If arr(r, 14) <> "" Then 'Wenn Inhalt in Spalte N
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & "" & arr(r, c) & "" & delim
Else
line = line & "" & arr(r, c) & ""
End If
Next
'End If
csvContent = csvContent & line & vbNewLine
End If
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
'End If
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub