AW: Mit Excel über ODBC auf mySQL-Db
16.03.2005 16:47:52
Fritz
Hallo,
Zuerst muss eine DSN (Data Source Name ) erstellt warden, die den Zugriff auf die Datenbank regelt.
Dies kann man manuell machen (z.B. in
Excel Menü "Daten | Externe Daten importieren | Daten importieren" und dann "neue Datenquelle erstellen) oder im Programm(siehe folgendes)
Sub ODBCAbfrage()
Dim SQLString
If Not GetDSNs(ODBCQuelle) Then Call addDSN(ODBCDrv, ODBCQuelle, Server, Beschreibung)
SQLString = " select PROJ_ID from kunde, projekt"
SQLString = SQLString & " where kund_id=proj_kund_id"
SQLString = SQLString & " and KUND_MATCHCODE = '" & Kunden.Text & "' "
SQLString = SQLString & " order by 1"
DoSQLinTabelle (SQLString) ' Abfrage ausführen
End Sub
Sub DoSQLinTabelle(Statement$)
Dim DB As New ADODB.Connection ' Datenbankobjekt
Dim CN ' Connection
Dim Rs As New ADODB.Recordset ' RecordSet
Dim FieldCounter&
Dim I&, J&
On Error GoTo ErrHandler
DB.Open "DSN=pas;uid=pas;pwd=pas"
Set Rs = DB.Execute(Statement, CN)
FieldCounter = Rs.Fields.Count
J = 2
Do
For I = 0 To Rs.Fields.Count - 1
cells(J, I + 1) = Rs.Fields(I)
Next
J = J + 1
Rs.MoveNext
Loop While Rs.EOF = False
Set Rs = Nothing
DB.Close
Exit Sub
ErrHandler:
Set Rs = Nothing
DB.Close
MsgBox ("Fehler")
End Sub
Function GetDSNs(ODBCQuelle$) As Boolean
'Dim Added As Long
Dim SysDSN As New Collection
Dim Eintrag As Variant
Dim DSNName As String
Dim Driver As String
Dim sDSNString As String
Dim sDesc As String
Dim iLenDSN As Integer
Dim iLenDesc As Integer
Dim nRet As Long
Dim hSQL As Long
Dim bContinue As Boolean
Dim sBuffer As String
Dim iBufSize As Integer
Dim sDriver As String
Dim DatenQuellen() As String
Dim ODBCTreiber() As String
Dim sDSNItem As String * 1024
Dim sDRVItem As String * 1024
Dim sDSN As String
Dim sDRV As String
Dim iDSNLen As Integer
Dim iDRVLen As Integer
Dim lHenv As Long 'Zugriffsnummer zur Umgebung
Dim I&
GetDSNs = False
On Error Resume Next
ReDim DatenQuellen(0)
ReDim ODBCTreiber(0)
'DSNs abrufen
If SQLAllocEnv(lHenv) <> -1 Then
Do Until I <> SQL_SUCCESS
sDSNItem = Space(1024)
sDRVItem = Space(1024)
' Aufruf der API Funktion zur Ausgabe der nächsten ODBC Verbindung
I = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
sDSN = Left(sDSNItem, iDSNLen)
sDRV = Left(sDRVItem, iDRVLen)
If sDSN <> Space(iDSNLen) Then
'cboDSNList.AddItem sDSN
If sDSN = ODBCQuelle Then GetDSNs = True
DatenQuellen(UBound(DatenQuellen)) = sDSN
ODBCTreiber(UBound(ODBCTreiber)) = sDRV
ReDim Preserve DatenQuellen(UBound(DatenQuellen) + 1)
ReDim Preserve ODBCTreiber(UBound(ODBCTreiber) + 1)
End If
Loop
End If
End Function
Public
Function addDSN(DriverName$, DSNName$, Server$, Description$)
Dim Added As Long
Added = SQLConfigDataSource(0, ODBC_ADD_SYS_DSN, DriverName & vbNullChar, _
"DSN=" & DSNName & vbNullChar & "UID=" & vbNullChar & "pwd=" & vbNullChar & _
"Server=" & Server & vbNullChar & "Description=" & Description & vbNullChar)
'Added ist 1 bei Erfolg und 0 bei Fehler
If Added = 0 Then
MsgBox "DSN konnte nicht hinzugefügt werden !", vbOKOnly, "ODBC Error"
End
Else
'MsgBox "DSN wurde erfolgreich hinzugefügt !", vbOKOnly, "ODBC"
End If
End Function