Sub ViaDrop()
Const Adressenpfad As String = "E:\WordVBA\Beispiel.xlsx"
Const sTablename As String = "Tabelle1$"
Const Spalte As Long = 1
Dim strInput As Variant
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim sField As String
Dim sFilter As String
Dim oData As New DataObject
Dim sText As String
Dim oCC As Word.ContentControl
Dim x As Long
With ActiveDocument
Set oCC = .ContentControls(1)
With oCC
strInput = .Range.Text
End With
End With
sSQL = "SELECT * FROM " & Chr(91) & sTablename & Chr(93)
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
With oConn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & Adressenpfad & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"""
.Open
End With
oRS.Open sSQL, oConn
If Not oRS.EOF Then
sField = "F" & Format(Spalte, "#")
sFilter = sField & " = " & Chr(39) & strInput & Chr(39)
oRS.Filter = sFilter
If Not oRS.EOF Then
sText = oRS.Fields(0) & vbLf & oRS.Fields(1) & vbLf & oRS.Fields(2)
With oData
.SetText sText
.PutInClipboard
End With
MsgBox "Zwischenablage gefüllt"
Else
MsgBox strInput & vbLf & "nicht erkannt"
End If
End If
Set oConn = Nothing
Set oRS = Nothing
Set oData = Nothing
Set oCC = Nothing
End Sub