MySQL Abfrage ausführen und als xls in bestimmten Ordner ablegen

	objExcel.Cells(cellCount, rowCount).Value = RS.Fields.Item("label").Value   
	objExcel.Cells(cellCount, rowCount+1).Value = RS.Fields.Item("dimension").Value   

	objExcel.Cells(cellCount, rowCount).Value = RS.Fields.Item("Schlüssel").Value   
	objExcel.Cells(cellCount, rowCount+1).Value = RS.Fields.Item("Ersteller").Value   

Option Explicit

'---- CursorTypeEnum Values ----  
Const adOpenForwardOnly = 0
' Const adOpenKeyset = 1  
' Const adOpenDynamic = 2  
' Const adOpenStatic = 3  

'---- LockTypeEnum Values ----  
Const adLockReadOnly = 1
' Const adLockPessimistic = 2  
' Const adLockOptimistic = 3  
' Const adLockBatchOptimistic = 4  

'---- CursorLocationEnum Values ----  
' Const adUseServer = 2  
Const adUseClient = 3

'---- ConnectModeEnum Values ----  
' Const adModeUnknown = 0  
Const adModeRead = 1
' Const adModeWrite = 2  
' Const adModeReadWrite = 3  
' Const adModeShareDenyRead = 4  
' Const adModeShareDenyWrite = 8  
' Const adModeShareExclusive = &Hc  
' Const adModeShareDenyNone = &H10  
' Const adModeRecursive = &H400000  
Dim objExcel
Dim objSheet
Dim Conn, RS
Dim rowCount, i, headerSet

rowCount = 1

Set objExcel = CreateObject("Excel.Application")  

objExcel.Visible = True
objExcel.Workbooks.Add

'Angabe des Tabellenblattes  
Set objSheet = objExcel.ActiveWorkbook.WorkSheets(2)

Set Conn = CreateObject("ADODB.Connection")  
Conn.Provider = "MSDASQL"  
Conn.Mode = adModeRead
Conn.CursorLocation = adUseClient
Conn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _  
          "DATABASE=database;" & _  
          "SERVER=192.168.x.x;", _  
          "user", "passwd"  

Set RS = CreateObject("ADODB.Recordset")  
RS.CursorLocation = adUseClient
RS.Source = "Select * from tools where id=120 OR id=122;"  
Set RS.ActiveConnection = Conn
RS.CursorType = adOpenForwardOnly
RS.LockType = adLockReadOnly
RS.Open          

Do While Not RS.EOF
'Die Spalenüberschriften einfügen  
	If( headerSet = 0 ) Then
		For i = 0 to RS.Fields.Count - 1
		  objSheet.Cells(rowCount, i+1).Value = RS.Fields.Item(i).Name
		Next
		headerSet = 1
    End If
'Die dazugehörigen Werte einfügen  
	For i = 0 to RS.Fields.Count -1 
	  objSheet.Cells(rowCount+1, i+1).Value = RS.Fields.Item(i).Value
	Next
    rowCount = rowCount + 1
	RS.MoveNext
Loop

RS.Close
Set RS = Nothing

Conn.Close
Set Conn = Nothing

'Speichern und überschreiben  
objExcel.Application.DisplayAlerts = false
objExcel.ActiveWorkbook.SaveAs "E:\vbs-sql-xls\test.xls"  
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit