vbs für MySQL to xls
Julia
ich hoffe ich bin mit dieser Thematik nicht falsch hier.
Ich habe ein Skript welches mir eine SQL-Abfrage auf unserer MySQL Datenbank macht und das Ergebnis in eine xls einfügt.
Leider kann sich mein Skript seit neustem nicht mehr mit der DB verbinden. DB ist umgezogen. Gebe ich die Parameter aus dem Skript in einen MySQL Browswer ein (IP, Server, Passwort und USer) klappt die Verbindung einwandfrei. Jemand eine Idee?:
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
MsgBox "Mit dem OK-Button wird der Import aus der DB gestartet."& vbCrLf & "Je nach SQL-Statement kann der Import mehrere Minuten dauern!" & vbCrLf & "Schließen Sie offene xls-Dokumente und vermeiden die Arbeit mit Excel während des Imports."& vbCrLf & "Sie werden über den Abschluss des Imports informiert!",64, "Info"
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 & "../Report.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};" & _
"DATABASE=db_Kunde;" & _
"SERVER=10.111.12.173;", _
"read_user", "passwort"
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
'objExcel.StatusBar = x & " Datensätze aus JIRA importiert" 'Text für Statusbar 'macht nur Sinn bei objExcel.Visible = True
'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 'macht nur Sinn bei objExcel.Visible = True
objExcel.Sheets("Fälligkeit").Select 'wählt die angegebene Mappe der zuvor geöffneten xls
objExcel.Cells(7, 5) = Date & " / " & Time & " Uhr" 'schreibt das Datum und die Zei des letzten Imports in das Sheet ICeD-Fälligkeitsliste in definierte Zelle
objExcel.Cells(8, 5) = x & " Datensätze" 'schreibt die Anzahl der importierten Datensätz in definierte Zelle von Sheet
RS.Close
Set RS = Nothing
Conn.Close
Set Conn = Nothing
MsgBox "Datenimport aus DB abgeschlossen! Die Datenbasis zeigt den Stand vom " & Date & " bis " & Time & "!" & vbCrLf & "Aktualisieren Sie die den Report über die Schaltfläche >>alle Pivots aktualisieren objExcel.Visible = True 'macht die zuvor geöffnete Datei nach Import sichtbar