|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub 查询()
- Range("a3:H65536").ClearContents
- Dim cnn As Object
- Dim Sql As String, myf, ARR(1 To 99, 1 To 2), M%, t$, u$
- t = Range("B1")
- u = Range("D1")
- Set cnn = CreateObject("ADODB.CONNECTION")
- myf = Dir(ThisWorkbook.Path & "\*.xls")
- Do While myf <> "" And myf <> ThisWorkbook.Name
- cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=No'; Data Source=" & ThisWorkbook.Path & "" & myf
- Sql = "select * from [" & t & "$A2:H999] WHERE [f8] like '" & u & "'"
- Range("a65536").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(Sql)
- cnn.Close
- myf = Dir()
- Loop
- Set cnn = Nothing
- End Sub
复制代码
|
|