Access - bestimmte Werte auslesen!

Unabhängig von dem allseits bekannten "Daten bzw. Daten - externe Daten importieren" folgend eine VBA-Lösung. Um dieses Beispiel nachvollziehen zu können muss zunächst die ENGLISCHE Version der Nordwinddatenbank aus dem Netz gezogen werden:

ENGLISCHE Version der Nordwinddatenbank

Im Code dann noch den Pfad anpassen und fertig. Es werden verschiedene Informationen aus der Tabelle "Employees" ausgelesen und über zwei Arten ausgegeben. Einmal über "CopyFromRecordset" und dann noch über eine "For-Schleife". Access muss nicht installiert sein.

Access - bestimmte Werte auslesen...[ZIP, 60 KB]

' Code in ein allgemeines Modul:

' Download ENGLISCHE Nordwinddatenbank http://tinyurl.com/2zm2mn
Option Explicit
' Pfad- und Dateiname anpassen
Const strFileName As String = "nwind.mdb"
Const strPath As String = "C:\Test\"
' Name der Accesstabelle bei Bedarf anpassen
Const strTableName As String = "Employees"
Public Sub DatenbankNWIND(ByVal lngRow As Long)
Dim strUpdate As String
Dim intCount As Integer
Dim rcsEntry As Object
Dim objConn As Object
Dim blnTMP As Boolean
On Error GoTo Fin
If Dir(strPath & strFileName) = "" Then
MsgBox "Datei nicht vorhanden!"
Else
strUpdate = Tabelle1.Cells(lngRow, 1).Value
If Trim(strUpdate) = "" Then MsgBox "A1 leer!": Exit Sub
If strUpdate = False Then Exit Sub
Set rcsEntry = CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")
With objConn
.CursorLocation = 3 ' = adUseClient
If Val(Application.Version) >= 12 Then
.Provider = "Microsoft.ACE.OLEDB.12.0"
Else
.Provider = "Microsoft.Jet.OLEDB.4.0"
End If
.Properties("Data Source") = strPath & strFileName
.Open
End With
With rcsEntry
.ActiveConnection = objConn
.CursorLocation = 3 ' = adUseClient
.LockType = 3 ' = adLockOptimistic
.CursorType = 1 ' = adOpenKeyset
.Source = "SELECT LastName, FirstName, Title, City FROM " & _
strTableName & " WHERE EmployeeID=" & strUpdate
.Open
If .RecordCount <> 0 Then
.MoveFirst
For intCount = 0 To rcsEntry.Fields.Count - 1
Tabelle1.Cells(intCount + 1, 8).Value = _
rcsEntry.Fields(intCount).Value
Next intCount
' Oder andere Ausgabe der Informationen
Tabelle1.Cells(lngRow, 2).CopyFromRecordset rcsEntry
Else
Tabelle1.Rows(lngRow).ClearContents
Tabelle1.Columns(8).ClearContents
MsgBox "ID in Datenbank nicht vorhanden!"
End If
End With
End If
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
If Not rcsEntry Is Nothing Then
If rcsEntry.State = 1 Then rcsEntry.Close
End If
If Not objConn Is Nothing Then
If objConn.State = 1 Then objConn.Close
End If
Set rcsEntry = Nothing
Set objConn = Nothing
End Sub


' Code in das Klassenmodul der Tabelle:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin
If Trim(Target.Value) = "" Then
Rows(Target.Row).ClearContents
Columns(8).ClearContents
Else
If Target.Count > 1 Or Trim(Target.Text) = "" Or _
Not IsNumeric(Target) Then Exit Sub
If Not Intersect(Target, Columns(1)) Is Nothing Then
Application.EnableEvents = False
Call DatenbankNWIND(Target.Row)
End If
End If
Fin:
Application.EnableEvents = True
End Sub


Nützliche Links:
Access - bestimmte Werte auslesen - Linkliste [TXT]

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...