Excel to Access

Abfragen der Daten in einer Access Datenbank aus Excel.

Schritte

1. Definieren der Objekte
2. Verbinden zur Datenbank
3. Abfrage definieren
4. Abfrage ausführen
5. Ergebnis anzeigen
6. Bereinigen der Objekte

Beispiel

Kontanten zur Datenbank für alle Schnittstellen.

Const SpwDBProvider As String = "Microsoft.ACE.OLEDB.12.0" ' je nach Version
Const SpwDBPath As String = "C:\Users\Ich\Documents\Datenbanken\"
Const SpwDBFile As String = "Spielwiese.accdb"

Zählen der Datensätze in einer Access Tabelle aus Excel heraus.

Public Sub CountRecords()
    
    ' Definieren der Objekte
    Dim cn As Object
    Dim rs As Object
    Dim strSql As String
    Dim strConnection As String
    
    ' Verbinden zur Datenbank
    Set cn = CreateObject("ADODB.Connection")
    sConnection = "Provider=" & SpwDBProvider & "; Data Source=" & SpwDBPath & SpwDBFile & ";"
     
    ' Abfrage definieren
    strSql = "SELECT Count(*) FROM Personen;"
    
    ' Abfrage ausführen
    cn.Open strConnection
    Set rs = cn.Execute(strSql)
    
    ' Ergebnis anzeigen
    MsgBox rs.Fields(0) & " rows in MyTable"
    
    ' Bereinigen der Objekte
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
End Sub

Abfragen einzelner Werte

Einzelne Werte eines Datensatzes können mit folgenden Routinen abgefragt werden. Es wird der erste Wert des ersten Datensatzes zurückgegeben!

' -------------------------------------------------
'
' SQl Schnittstelle zur Rückgabe eines einzelnen
' Long Wertes aus einer Tabellenabfrage.
'
' Parameter: SQL Abfrage
' Rückgabe des Wertes aus Field(0) des Recordset
'

Public Function sql_Long(sSQL As String) As Long

    ' Definieren der Objekte
    Dim cn As Object
    Dim rs As Object
    Dim sConnection As String
    
    ' Verbinden zur Datenbank
    Set cn = CreateObject("ADODB.Connection")
    sConnection = "Provider=" & SpwDBProvider & "; Data Source=" & SpwDBPath & SpwDBFile & ";"
     
    ' Abfrage ist im Übergabeparameter definiert
       
    ' Abfrage ausführen
    On Error GoTo ErrorSQL
      cn.Open sConnection
      Set rs = cn.Execute(sSQL)
    On Error GoTo 0
    
    ' Ergebnis zurückgeben
    If Not rs.EOF Then
      On Error GoTo ErrorNoNumber
        sql_Long = rs.Fields(0)
      On Error GoTo 0
    Else
      sql_Long = 0
    End If
        
    ' Bereinigen der Objekte
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
  
    Exit Function
    
ErrorNoNumber:
  On Error GoTo 0
  sql_Long = 0
  
  ' Bereinigen der Objekte
  rs.Close
  Set rs = Nothing
  cn.Close
  Set cn = Nothing
  Exit Function

ErrorSQL:
  On Error GoTo 0
  sql_Long = -1
  
  ' Bereinigen der Objekte
  Set rs = Nothing
  cn.Close
  Set cn = Nothing
  Exit Function

End Function

' -------------------------------------------------
'
' SQl Schnittstelle zur Rückgabe einer einzelnen
' Zeichenkette aus einer Tabellenabfrage.
'
' Parameter: SQL Abfrage
' Rückgabe des Wertes aus Field(0) des Recordset
'

Public Function sql_String(sSQL As String) As String

    ' Definieren der Objekte
    Dim cn As Object
    Dim rs As Object
    Dim sConnection As String
    
    ' Verbinden zur Datenbank
    Set cn = CreateObject("ADODB.Connection")
    sConnection = "Provider=" & SpwDBProvider & "; Data Source=" & SpwDBPath & SpwDBFile & ";"
     
    ' Abfrage ist im Übergabeparameter definiert
       
    ' Abfrage ausführen
    cn.Open sConnection
    Set rs = cn.Execute(sSQL)
 
    ' Ergebnis zurückgeben
    If Not rs.EOF Then
      On Error GoTo ErrorNoString
        sql_String = rs.Fields(0)
      On Error GoTo 0
    Else
      sql_String = ""
    End If
        
    ' Bereinigen der Objekte
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Function
       
ErrorNoString:
    On Error GoTo 0
    sql_String = ""
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Function
    
End Function

Beispiel

Public Function Nachname(pnr As Long) As String

  Nachname = sql_String("select Nachname from Personen where pnr=" & Str(pnr) & ";")

End Function

Eine Alternative zur obigen Routine zum Zählen der Datensätze wäre die Formel:

  =sql_Long("select count(*) from Personen;")

Kopieren einer Abfrage mit Parametern

Das folgende Beispiel setzt eine Datenbank Spielwiese.accdb mit Personaldaten mindesten drei Feldern Name, Vorname, GebDat voraus.

Es wird das Geburtsjahr abgefragt und das Abfrageergebnis ab der aktiven Zelle eingefügt.

Public Sub InsertQuery()

' Step 1: Declare your variables
' Definieren der Objekte
  Dim cn As Object
  Dim rs As Object
  Dim sSQL As String
  Dim sConnection As String
  Dim Jahr As Integer
  
  Jahr = Application.InputBox("Bitte ein Jahr eingeben", 1)
  
  ' Verbinden zur Datenbank
  Set cn = CreateObject("ADODB.Connection")
  sConnection = "Provider=" & SpwDBProvider & "; Data Source=" & SpwDBPath & SpwDBFile & ";"
    
' Abfrage definieren
  sSQL = "SELECT Personen.GebDat, Personen.Name, Personen.Vorname FROM Personen WHERE (((Year([GebDat])) = " _
    & Str(Jahr) _
    & " )) ORDER BY Personen.GebDat, Personen.Name, Personen.Vorname;"
       
' Abfrage ausführen
  cn.Open sConnection
  Set rs = cn.Execute(sSQL)
' Copy the recordset to Excel
  Selection.CopyFromRecordset rs
  
  MsgBox "Your Query has been Run"

End Sub

27.03.2000	Kammer	Wolfgang
28.04.2000	Dietze	Cristine
18.05.2000	Lauterbach	Sigismondo
21.05.2000	Hafner	Hilda
08.07.2000	Kayser	Heindrick
21.07.2000	Bauer	Jeremiah
08.08.2000	Höppner	Murial
02.09.2000	Baumgarten	Joann
12.09.2000	Keller	Sanderson
23.11.2000	Blome	Bellina
26.12.2000	Bauer	Mayne

Als Klassenmodul

Option Explicit
Public strFarbe As String
Private strDBProvider As String
Private strDBFile As String
Private Sub Class_Initialize()

  strDBProvider = "Microsoft.ACE.OLEDB.12.0"
  strDBFile = ""
  
End Sub

Public Property Let Database(DBFile As String)
  
  strDBFile = DBFile

End Property

Public Property Get Database() As String
    Database = strDatabase
End Property

Public Function GetLong(sSQL As String) As Long

' sSQL. Abfrage die ausgeführt werden soll

    ' Definieren der Objekte
    Dim cn As Object
    Dim rs As Object
    Dim sConnection As String
    
    ' Verbinden zur Datenbank
    Set cn = CreateObject("ADODB.Connection")
    sConnection = "Provider=" & strDBProvider & "; Data Source=" & strDBFile & ";"
    
    ' Abfrage ausführen
    On Error GoTo ErrorSQL
      cn.Open sConnection
      Set rs = cn.Execute(sSQL)
    On Error GoTo 0
    
    ' Ergebnis zurückgeben
    If Not rs.EOF Then
      On Error GoTo ErrorNoNumber
        sql_Long = rs.Fields(0)
      On Error GoTo 0
    Else
      sql_Long = 0
    End If
        
    ' Bereinigen der Objekte
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
  
    Exit Function
    
ErrorNoNumber:
  On Error GoTo 0
  GetLong = 0
  
  ' Bereinigen der Objekte
  rs.Close
  Set rs = Nothing
  cn.Close
  Set cn = Nothing
  Exit Function

ErrorSQL:
  On Error GoTo 0
  GetLong = -1
  
  ' Bereinigen der Objekte
  Set rs = Nothing
  cn.Close
  Set cn = Nothing
  Exit Function

End Function

Public Function GetString(sSQL As String) As String

' sSQL. Abfrage die ausgeführt werden soll

    ' Definieren der Objekte
    Dim cn As Object
    Dim rs As Object
    Dim sConnection As String
    
    ' Verbinden zur Datenbank
    Set cn = CreateObject("ADODB.Connection")
    sConnection = "Provider=" & strDBProvider & "; Data Source=" & strDBFile & ";"
    
    ' Abfrage ist im Übergabeparameter definiert
       
    ' Abfrage ausführen
    cn.Open sConnection
    Set rs = cn.Execute(sSQL)
 
    ' Ergebnis zurückgeben
    If Not rs.EOF Then
      On Error GoTo ErrorNoString
        GetString = rs.Fields(0)
      On Error GoTo 0
    Else
      GetString = "--EOF--"
    End If
        
    ' Bereinigen der Objekte
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Function
       
ErrorNoString:
    On Error GoTo 0
    GetString = "--Err: No String--"
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Function
    
End Function

Public Sub InsertQueryResult(sSQL As String, Optional AtCell As String = "?")


' sSQL: Abfrage die ausgeführt werden soll.
' AtCell: Position (Cell) ab der das Abfrageergebnis kopiert werden soll. 
'         Default: Aktive Zelle 

' Definieren der Objekte

  Dim cn As Object
  Dim rs As Object
  Dim sConnection As String
  Dim Target As Range
  
  If AtCell = "?" Then
    Set Target = Selection
  Else
    Set Target = Range(AtCell)
  End If
    
  ' Verbinden zur Datenbank
  Set cn = CreateObject("ADODB.Connection")
  sConnection = "Provider=" & strDBProvider & "; Data Source=" & strDBFile & ";"
     
' Abfrage ausführen
  cn.Open sConnection
  Set rs = cn.Execute(sSQL)
' Copy the recordset to Excel
  Target.CopyFromRecordset rs

   
End Sub