Fortschrittsanzeige für folgenden Code

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  


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 & "../test.xls")'öffnet die angegebene xls  



objExcel.Visible = False
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};" & _  
          "DATABASE=name;" & _  
          "SERVER=server;", _  
          "user", "password"  

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

Do While Not RS.EOF
objExcel.StatusBar = x & " Datensätze aus DB importiert" 'Text für Statusbar  
'Die Spalenüberschriften einfügen Bezug aus dem SQL-Statement  
	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
	
x = x + 1
Loop
objExcel.Statusbar = False 'Statusbar bereinigen  


objExcel.Sheets("Pivot1").Select 'wählt die angegebene Mappe der zuvor geöffneten xls  


RS.Close
Set RS = Nothing

Conn.Close
Set Conn = Nothing


MsgBox "Datenimport! Die Datenbasis zeigt den Stand vom " &  Date  & " bis " & Time & "!" & vbCrLf & "Aktualisieren Sie die Pivottabellen über die Schaltfläche!" & vbCrLf & "Es wurden " & x & " Datensätze aus DB importiert",64, "Info"  

SELECT COUNT(*) FROM Kunden';