Sub test()
Dim fn$, pth$, cnt%, fns()
Dim conn As Object, rst As Object, sql$, re$(), i&
'变量说明:fn=文件名称,pth=文件路径,cnt=汇总文件的计数;结果数组的计数
'变量说明:fns=存放局部sql语句,sql=最终执行的sql语句,re$()=最终结果数组(如果不需要全部为文本类型可取消定义文本)
'变量说明:conn=ado连接数据库对象,rst=ado数据集对象,i=用于循环数据集中每列的存放记录
pth = ThisWorkbook.Path & "\"
fn = Dir(pth & "*.xls*")
'-----------------------------------------------------------------------------------------
Do '循环读取工作表名并存放局部的sql语句到fns数组中
If fn <> ThisWorkbook.Name Then
cnt = cnt + 1
ReDim Preserve fns(1 To cnt)
fns(cnt) = "select * from [" & pth & fn & "].[销售明细$a2:i] where len(编号)" '此处如果文件可用区域(100w行的那个背景颜色)不是这么大的话可以省略where
End If
fn = Dir
Loop While Len(fn)
'-----------------------------------------------------------------------------------------
sql = Join(fns, " Union All ") '连接各表格的sql语句生成
Set conn = CreateObject("adodb.connection")
Set rst = CreateObject("adodb.recordset")
conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
rst.Open sql, conn, 1, 1 '打开数据集方式(游标+只读)
ReDim re(1 To rst.RecordCount, 1 To rst.Fields.Count) '定义结果数组大小
cnt = 0
'-----------------------------------------------------------------------------------------
'循环去读所有记录到数组中
Do Until rst.EOF = True
cnt = cnt + 1
For i = 0 To rst.Fields.Count - 1
re(cnt, i + 1) = rst.Fields.Item(i)
Next
rst.movenext
Loop
'-----------------------------------------------------------------------------------------
'关闭各对象
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub
'试试看行不行吧。。。