多工作簿多工作表查询

zhongchangliang

写了一个多工作簿多工作表的查询，分别用数组法和ADO法，但是如果第四季度.xlsx表中的数据填汉字，用ADO就查不出来，想不出是什么原因，请知道的朋友指点下，谢谢。

2019032

你把那一列分列成文本看看

zhongchangliang

2019032 发表于 2015-11-4 15:29
你把那一列分列成文本看看

照你说的做果然好了，这怎么解释？

2019032

zhongchangliang 发表于 2015-11-4 16:59
照你说的做果然好了，这怎么解释？

数据库  字段  格式必须一致。

zhaogang1960

请参考：

1. Sub ADO查询()
   
2.     Dim cnn As Object, rs As Object, rst As Object, SQL$, MyPath$, MyName$, m&, r&, s$, t$
   
3.     Application.ScreenUpdating = False
   
4.     r = 2
   
5.     Range("I2:N1000") = ""
   
6.     t = ThisWorkbook.Worksheets(1).Range("A1").Value
   
7.     MyPath = ThisWorkbook.Path & "\分表"
   
8.     MyName = Dir(MyPath & "*.xlsx")
   
9.     Do While MyName <> ""
   
10.         Set cnn = CreateObject("ADODB.Connection")
    
11.         cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & MyPath & MyName
    
12.         Set rs = cnn.OpenSchema(20)
    
13.         Do Until rs.EOF
    
14.             If rs.Fields("TABLE_TYPE") = "TABLE" Then
    
15.                 s = Replace(rs("TABLE_NAME").Value, "'", "")
    
16.                 If Right(s, 1) = "$" Then
    
17.                     SQL = "select 月份,出生地,学历,职位,数量 from [Excel 12.0;DATABASE=" & MyPath & MyName & "].[" & s & "A1:F100] where 姓名 =  '" & t & "'order by 月份"
    
18.                     Set rst = CreateObject("ADODB.recordset")
    
19.                     rst.Open SQL, cnn, 1, 3
    
20.                     If rst.RecordCount Then
    
21.                         Range("i" & r).CopyFromRecordset rst
    
22.                         r = r + rst.RecordCount
    
23.                     End If
    
24.                 End If
    
25.             End If
    
26.             rs.MoveNext
    
27.         Loop
    
28.         MyName = Dir()
    
29.     Loop
    
30.     rs.Close
    
31.     rst.Close
    
32.     cnn.Close
    
33.     Set rs = Nothing
    
34.     Set rst = Nothing
    
35.     Set cnn = Nothing
    
36.     Application.ScreenUpdating = True
    
37. End Sub
    

复制代码

zhaogang1960

请测试附件
多工作簿多工作表查询.rar (57.7 KB, 下载次数: 106)

2015-11-4 17:35 上传

点击文件名下载附件

aman1516

多工作薄多工作表查询，向版主学习下

zhongchangliang

zhaogang1960 发表于 2015-11-4 17:34
请参考：

谢谢赵老师解答，代码有几处还看不懂，问题解决了

LMY123

Set rs = cnn.OpenSchema(20)

补充内容 (2019-1-1 17:37):
单夹_多薄_多表_单条件查询_数组法，ADO，已入库。