从工作表查询数据

Sub 从工作表中查询数据()
Dim cnn As ADODb.Connection
Dim rs  As ADODb.Recordset
Dim strsql As Stream
Dim str1  As Stream
On Error Resume Next
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cnn.Open "provider=microsoft.jet.oledb.4.0;" _
& "extended properties=excel 8.0;" _
& "data source=" & ThisWorkbook.FullName
str1 = ActiveSheet.Range("a2")
strsql = "select * from [数据库$] where  商品名称 like '% " & str1 & " %'"
rs.Open strsql, cnn, adOpenStatic
With ActiveSheet
    .Range("a5:g1000").ClearContents
    .Range("a5").CopyFromRecordset rs
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub