пропозиції роботи
Bartek
Borczyk
Operator liczb i
słów
Temat: MYSQL A ADODB
Witam,Mam problem z pobraniem danych z serwera MySql przez ADODB w Excelu. Poniższy kod zwraca dane w dziwnej postaci. Pierwsza kolumna jest ok (kompletna) dla wszystkich rekordów. Dla wszystkich pozostałych rekordów tylko w rekordzie nr 257 są dane dla wszystkich kolumn. Reszta jest pusta, choć w bazie faktycznie jest inaczej.
Wygląda to mniej więcej tak:
lp pracownik cel1 cel1zaliczony
1 nr1
2 nr2
3 nr3
…
257 nr257 cel1 1
258 nr258
259 nr259
…
Kolumny 1,2,3...258,259... w bazie nie są puste. Co jest nie tak?
Kod wygląda tak:
Sub sJoomla()
Dim wksZeszyt As Worksheet
Dim rngStartowa As Range
Dim strSql As String
Set wksZeszyt = ThisWorkbook.Worksheets("cele_joomla")
Set rngStartowa = wksZeszyt.Range("A1")
strSql = "select pracownik, cel1, cel2, cel3, cel4, cel1zaliczony, cel2zaliczony, cel3zaliczony, cel4zaliczony from jos_gti_cele where okres = '201109' order by pracownik"
wksZeszyt.Cells.Clear
fKopiujRekordsetDoKomorki rngStartowa, fDajRekordset(enuTekst, strSql, , fDajPolaczenie(enuJoomla), adOpenStatic), True, True
MsgBox "Gotowe!"
End Sub
Function fDajPolaczenie(Optional enuPolaczenie As enuPolaczenia = 1) As ADODB.Connection
Dim strLancuch As String
Dim adodbPolaczenie As New ADODB.Connection
'If blnUkryjBledy Then On Error GoTo regionBlad
If enuPolaczenie = enuJoomla Then strLancuch = "Driver={MySQL ODBC 5.1 Driver};Server=xxx;Database=gti_joomla;User=xxx;Password=xxx;Option=3"
With adodbPolaczenie
.ConnectionString = strLancuch
.Open
End With
Set fDajPolaczenie = adodbPolaczenie
Exit Function
regionBlad:
MsgBox "Uwaga! Wystąpił błąd przy utworzeniu połączenia.", vbCritical
Set fDajPolaczenie = Nothing
End Function
Function fDajRekordset(enuKomenda As enuKomendy, strTekst As String, _
Optional varParametry As Variant, Optional adodbPolaczenie As ADODB.Connection, _
Optional enuTypKursora As CursorTypeEnum = adOpenForwardOnly, Optional enuLokacjaKursora As CursorLocationEnum = adUseServer) As ADODB.Recordset
Dim adodbRekordset As New ADODB.Recordset
Dim adodbKomenda As New ADODB.Command
Dim adodbParametr As ADODB.Parameter
Dim i As Integer
'If blnUkryjBledy Then On Error GoTo regionBlad
If adodbPolaczenie Is Nothing Then
Set adodbPolaczenie = fDajPolaczenie
End If
With adodbRekordset
.CursorType = enuTypKursora
.CursorLocation = enuLokacjaKursora
End With
With adodbKomenda
.ActiveConnection = adodbPolaczenie
If enuKomenda = enuProcedura Then .CommandType = adCmdStoredProc
If enuKomenda = enuTabela Then .CommandType = adCmdTable
If enuKomenda = enuTekst Then .CommandType = adCmdText
.CommandText = strTekst
.CommandTimeout = mintLimitCzasu
.Parameters.Refresh
If Not IsMissing(varParametry) Then
For i = LBound(varParametry, 1) To UBound(varParametry, 1)
.Parameters(varParametry(i, 0)).Value = varParametry(i, 1)
Next i
End If
Set adodbRekordset = .Execute
End With
Set fDajRekordset = adodbRekordset
GoTo regionCzysc
regionBlad:
MsgBox "Uwaga! Wystąpił błąd przy pobraniu rekordsetu.", vbCritical
regionCzysc:
Set adodbRekordset = Nothing
Set adodbPolaczenie = Nothing
Set adodbKomenda = Nothing
Set adodbParametr = Nothing
End Function
Function fKopiujRekordsetDoKomorki(rngKomorka As Range, adodbRekordset As ADODB.Recordset, Optional blnCzyNaglowki As Boolean, Optional blnCzyDopasowac As Boolean = True) As Boolean
Dim adodbPole As ADODB.Field
Dim intIle As Integer
Dim varNaglowki As Variant
Dim i As Integer
Dim j As Integer
'If blnUkryjBledy Then On Error GoTo regionBlad
j = 1
If blnCzyNaglowki Then
With adodbRekordset
intIle = .Fields.Count
ReDim varNaglowki(intIle - 1)
i = -1
For Each adodbPole In .Fields
i = i + 1
If Len(adodbPole.Name) > 0 Then
varNaglowki(i) = adodbPole.Name
Else
varNaglowki(i) = "Pole" & i
End If
Next adodbPole
End With
rngKomorka.Cells(j, 1).Resize(, intIle).Value = varNaglowki
j = j + 1
End If
With rngKomorka
.Cells(j, 1).CopyFromRecordset adodbRekordset
If blnCzyDopasowac Then .Worksheet.Columns.EntireColumn.AutoFit
End With
fKopiujRekordsetDoKomorki = True
Exit Function
regionBlad:
MsgBox "Uwaga! Nie można skopiować rekordsetu do komórki.", vbCritical
fKopiujRekordsetDoKomorki = False
End Function
