Aus vbs eine xls unter Monatsangabe speichern?

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, objWb, SkriptPfad
Dim objSheet
Dim Conn, RS
Dim rowCount, i, headerSet
Dim x 'Zähler für Statusbar  





x = 0 'Anfangswert für Zähler - Anzahl importierter Datensätze  


rowCount = 1

SkriptPfad = WScript.ScriptFullName 'Pfadermittlung  
SkriptPfad = Left(SkriptPfad, Len(SkriptPfad) - Len(WScript.ScriptName))  'Pfadermittlung  


Set objExcel = CreateObject("Excel.Application")   
Set objWb = objExcel.Workbooks.Open(SkriptPfad & "Import.xls")'öffnet die angegebene xls  



objExcel.Visible = False 'die geöffnete xls ist während dem Import nicht sichtbar  
objExcel.Sheets("Datenbasis").Select 'wählt die angegebene Mappe der zuvor geöffneten xls  
objExcel.Range("Datenbasis!$1:$65536").ClearContents 'löscht alle Inhalte von angegebener Mappe  

'Angabe des Tabellenblattes  
Set objSheet = objExcel.ActiveWorkbook.WorkSheets("Datenbasis") 'Import in angegebenes Tabellenblatt  

Set Conn = CreateObject("ADODB.Connection")  
Conn.Provider = "MSDASQL"  
Conn.Mode = adModeRead
Conn.CursorLocation = adUseClient
Conn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _  
          "SERVER=10.11.12.33;UID=read;PWD=Test;Port=1141;database=db_kunde"  
         

Set RS = CreateObject("ADODB.Recordset")  
RS.CursorLocation = adUseClient
'verwendete SQL-Anweisung  
RS.Source = "SELECT * FROM Kunde;"  
Set RS.ActiveConnection = Conn
RS.CursorType = adOpenForwardOnly
RS.LockType = adLockReadOnly
RS.Open          

Do While Not RS.EOF

	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
	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
	
x = x + 1
Loop
'objExcel.Statusbar = False 'Statusbar bereinigen 'macht nur Sinn bei objExcel.Visible = True  


objExcel.Sheets("Basis").Select   
objExcel.Cells(12, 5) = Date & " / " & Time & " Uhr"   
objExcel.Cells(13, 5) = x & " Datensätze"   


RS.Close
Set RS = Nothing

Conn.Close
Set Conn = Nothing


objExcel.Visible = False 'macht die zuvor geöffnete Datei nach Import sichtbar wenn True eingestellt  
objExcel.Run "alles_aktualisieren"  
objExcel.Run "alles_aktualisieren"  
objExcel.ActiveWorkBook.Save 
objExcel.Quit