Acces 2003 VBA Abfrageergebnis als .csv speichern

Hallo,

habe hier ein kleines aber nerviges Problemchen. Ich muss zwingend ein Abfrageergebnis aus Access 2003 als Excel CSV speichern.
Dazu hab ich schon diverse freie Codeschnipsel probiert, hier wäre die perfekte Lösung allerdings speichert er das File nicht als CSV sondern als Excel Tabelle.

Kann und mag mir jemand helfen ?

Gruß,
Roberth


Hier mal der Code:

unction OLEExcelExport(ExcelFullDatNam As String, ExcelTabNam As String, _
ExcelOffenLassen As Boolean, _
ParamArray Werteliste()) As Boolean
' ============
' Ab Access 97
' ============
' Standard Excel-Export kann nur neue Tabellen erzeugen und komplette Abfragen
' exportieren
'
' Deshalb eigene Funktion:
' - Exportiert eine Datenzeile (bestehende) (offene) Exceltabelle
' - Daten werden an die letzte freie Zeile angehängt
' - Datei, Tabelle können bei Bedarf erzeugt werden
' - ist Excelanwendung kann offen gehalten werden
' ParamArray: übergeben werden entweder einzelne Werte oder ein Wertefeld
Const xlUp = -4162 ' so spart man den Verweis auf MS Excel
Dim WorkBookNam As String
Dim TabExist As Boolean, ExcelIsOpen As Boolean, WorkbookIsOpen As Boolean
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Dim ErsteFreieZeile As Long, i As Integer, AktSpalte As Integer
Dim j As Integer

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
Else
ExcelIsOpen = True
End If
On Error GoTo 0
' 1. Exceldatei evtl. öffnen/anlegen
' evtl ".xls" anhängen
If Len(ExcelFullDatNam) < 5 Then ExcelFullDatNam = ExcelFullDatNam & ".csv"
If Mid(ExcelFullDatNam, Len(ExcelFullDatNam) - 3, 4) <> ".csv" Then _
ExcelFullDatNam = ExcelFullDatNam & ".csv"
' -> alle .xls in .csv getauscht
If Len(Dir(ExcelFullDatNam)) > 0 Then
WorkBookNam = NurDatNam(ExcelFullDatNam)
For Each xlBook In xlApp.Workbooks
If xlBook.name = WorkBookNam Then WorkbookIsOpen = True
Next
If Not WorkbookIsOpen Then
Set xlBook = xlApp.Workbooks.Open(ExcelFullDatNam)
Else
Set xlBook = xlApp.Workbooks(WorkBookNam)
End If
Else
Set xlBook = xlApp.Workbooks.Add
xlBook.SaveAs ExcelFullDatNam
End If
' 2. Tabellenblatt zuweisen/anlegen
For Each xlSheet In xlBook.Worksheets
If xlSheet.name = ExcelTabNam Then TabExist = True
Next
If TabExist Then
Set xlSheet = xlBook.Worksheets(ExcelTabNam)
Else
Set xlSheet = xlBook.Worksheets.Add
xlSheet.name = ExcelTabNam
End If
With xlSheet
' erste freie Zeile (Spalte A leer) ermitteln
.Activate ' falls Exceldatei geöffnet war
ErsteFreieZeile = .Range("A65536").End(xlUp).row + 1
If ErsteFreieZeile = 2 Then
If .Cells(1, 1) = "" Then ErsteFreieZeile = 1
End If
For i = 0 To UBound(Werteliste)
If IsArray(Werteliste(i)) Then
For j = 0 To UBound(Werteliste(i))
AktSpalte = AktSpalte + 1
.Cells(ErsteFreieZeile, AktSpalte) = Werteliste(i)(j)
Next j
Else
AktSpalte = AktSpalte + 1
.Cells(ErsteFreieZeile, AktSpalte) = Werteliste(i)
End If
Next i
End With
If ExcelOffenLassen = True Then
xlApp.Visible = True
Else
xlBook.Save
xlBook.Close
' falls Excel geöffnet wurde jetzt schließen
If Not ExcelIsOpen Then xlApp.Application.Quit

End If

xlApp.ActiveWorkbook.Save
xlApp.ActiveWindow.Close
xlApp.Application.Quit


Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
OLEExcelExport = True
End Function