AW: Recordset aus Function übergeben
20.01.2009 13:53:43
Mike
ok, hab hier mal was geschrieben, was auch läuft:
Sub TestADO()
Dim Frage As String, Ziel As Worksheet
Dim db As String
Dim conn As New ADODB.Connection
Dim server, Driver As String
Dim UID, PWD As String
Dim x, y As Long
Dim AnzahlZeilen, AnzahlSpalten As Long
Dim rs As ADODB.Recordset
Dim arrRs() As Variant
db = "db1"
Select Case db
Case "db1"
server = Server1
Driver = "SQL Server"
UID = UID1
PWD = PWD1
Case "db2"
server = Server2
Driver = "MySQL ODBC 5.1 Driver"
UID = UID2
PWD = PWD2
End Select
Frage = "Select * from db1.table"
Set conn = New ADODB.Connection
conn.Open _
"DRIVER={" & Driver & "}" & _
";SERVER=" & server & _
";UID=" & UID & _
";PWD=" & PWD
Set rs = New ADODB.Recordset
rs.Open Frage, conn, adOpenKeyset, adLockReadOnly
With rs
.MoveFirst
x = 1
'Anzahl Zeilen ermitteln / Recordcount geht nicht (?)
AnzahlZeilen = 1
While Not .EOF
.MoveNext
AnzahlZeilen = AnzahlZeilen + 1
Wend
AnzahlSpalten = rs.Fields.Count
ReDim arrRs(1 To AnzahlZeilen, 1 To AnzahlSpalten)
.MoveFirst
While Not .EOF
For y = 1 To AnzahlSpalten
Debug.Print rs(y - 1)
arrRs(x, y) = rs(y - 1).Value
Next y
.MoveNext
x = x + 1
Wend
End With
On Error Resume Next
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
On Error GoTo 0
End Sub
Soweit, so gut. Jetzt wollte ich das wie oben beschrieben aufteilen und über
Function aufrufen:
Sub abcd()
Dim arrRs() As Variant
arrRs = rs2Array("db1", "Select * from db1.table")
End Sub
Function rs2Array(db As String, Frage As String)
' unter Extras - Verweise muss Microsoft Active X Data Objects 2.x library aktiviert werden!
Dim conn As New ADODB.Connection
Dim server, Driver As String
Dim UID, PWD As String
Dim x, y As Long
Dim AnzahlZeilen, AnzahlSpalten As Long
Dim rs As ADODB.Recordset
Select Case db
Case "db1"
server = Server1
Driver = "SQL Server"
UID = UID1
PWD = PWD1
Case "db2"
server = Server2
Driver = "MySQL ODBC 5.1 Driver"
UID = UID2
PWD = PWD2
End Select
Set conn = New ADODB.Connection
conn.Open _
"DRIVER={" & Driver & "}" & _
";SERVER=" & server & _
";UID=" & UID & _
";PWD=" & PWD & _
Set rs = New ADODB.Recordset
rs.Open Frage, conn, adOpenStatic
With rs
.MoveFirst
'Anzahl Zeilen ermitteln / Recordcount geht nicht (?)
AnzahlZeilen = 1
While Not .EOF
.MoveNext
AnzahlZeilen = AnzahlZeilen + 1
Wend
AnzahlSpalten = rs.Fields.Count
ReDim rs2Array(1 To AnzahlZeilen, 1 To AnzahlSpalten)
.MoveFirst
x = 1
While Not .EOF
For y = 1 To AnzahlSpalten
Debug.Print rs(y - 1)
rs2Array(x, y) = rs(y - 1).Value
Next y
.MoveNext
x = x + 1
Wend
End With
'Close connections
On Error Resume Next
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
On Error GoTo 0
End Function
Das gibts dann ja einen Fehler beim Redim des Array.
Ich brauch einfach neuen Input, so komm ich nicht weiter. Wär toll, wenn jemand eine Anregung hat.
Cheers
Mike