msgBox oder Fortschrittsbalken?

Julia · 2009-03-05T11:31:28+00:00

Hallo, ich habe eine *.vbs die mir Daten aus einer MySQL Datenbank in eine xls importiert. Der Vorgang dauert 4 bis 5 min. Ich würde den User gerne über den laufenden Import informieren Kann man wenn das vbs die xls öffnet sofort eine InfoBox einblenden lassen? Wenn der Import fertig ist generierrt die vbs selbst eine MsgBox wo mitgeteilt wird das der Import abgeschlossen ist. Aber für die Zwischenzeit hätte ich gerne eine Meldung das der Import läuft Ein fortschrittsbalken wäre natürlich noch edler Eine Idee?

So sieht der import code aus
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
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 = True
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=dbname;" & _
"SERVER=server;", _
"user", "pw"
Set RS = CreateObject("ADODB.Recordset")
RS.CursorLocation = adUseClient
'verwendete SQL-Anweisung
RS.Source = "SELECT * from Kunden;"
Set RS.ActiveConnection = Conn
RS.CursorType = adOpenForwardOnly
RS.LockType = adLockReadOnly
RS.Open
Do While Not RS.EOF
'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
Loop
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 abgeschlossen! Die Datenbasis zeigt den Stand vom " & Date & " bis " & Time & "!",64, "Info"

Nein der Code steht nicht in der Excel Mappe
Der von mir gepostete Code ist eine *.vbs
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
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 = True
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=dbname;" & _
"SERVER=server;", _
"user", "pw"
Set RS = CreateObject("ADODB.Recordset")
RS.CursorLocation = adUseClient
'verwendete SQL-Anweisung
RS.Source = "SELECT * from Kunden;"
Set RS.ActiveConnection = Conn
RS.CursorType = adOpenForwardOnly
RS.LockType = adLockReadOnly
RS.Open
Do While Not RS.EOF
'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
Loop
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 abgeschlossen! Die Datenbasis zeigt den Stand vom " & Date & " bis " & Time & "!",64, "Info"

Forumthread: msgBox oder Fortschrittsbalken?

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial