verknüpfte DB

Sub ADO_Recordset_komplett_uebernehmen()
Application.ScreenUpdating = False
Dim con As ADODB.Connection
Dim datei As String
Dim fld As Field
Dim rs As ADODB.Recordset
Dim spalte As Long
Dim accTab As String
Dim ws As Worksheet
Dim zeile As Long
Dim s As String
'Den Ausgangswert für die Suche in die Variable s schreiben
s = Range("D2").Value
' (0) SQL-String
'accTab = "SELECT DOMAIN FROM x86Intel WHERE INVENTARNR = " & "'" & s & "'"
accTab = "SELECT DOMAIN FROM x86Intel WHERE INVENTARNR = " & s
' (1) Verbindung zur Datenbank herstellen
datei = "F:\Daten\Access\LSM_NEU.mdb"
Set con = New ADODB.Connection
con.Open ConnectionString:= _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & datei
' (2) Recordset erstellen
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
rs.Open Source:=accTab, _
ActiveConnection:=con, _
CursorType:=adOpenKeyset, _
LockType:=adLockReadOnly, _
Options:=adCmdTableDirect
' (3a) Tabellenblatt selektieren
Set ws = ThisWorkbook.Worksheets("Tabelle1")
' (3b) Stelle angeben, an die der neue Wert in Excel übergeben werden soll
ws.Range("D20").CopyFromRecordset _
Data:=rs, _
MaxRows:=ws.Rows.Count - 1, _
MaxColumns:=ws.Columns.Count
' (4) Recordset und Verbindung schließen
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
Application.ScreenUpdating = True
End Sub