|
Rem 获取文件清单
FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
If FileArr(0) <> "" Then '//如果文件清单 不是空白的
ICOUNT = UBound(FileArr) + 1
Rem 遍历每个分表文件
For I = 0 To ICOUNT - 1
Str_coon = "HDR=yes';Data Source =" & FileArr(I) '//OFFICE2003,2007 通用
Set WB = Workbooks.Open(FileArr(I)) '//打开工作簿 这里
Rem 遍历工作表
For Each SH In WB.Worksheets
Rem 查询数据
StrSQL = "SELECT '" & GetPathFromFileName(FileArr(I)) & "' AS 工作簿名"
StrSQL = StrSQL & ",'" & SH.Name & "' AS 工作表名"
StrSQL = StrSQL & StrBT
StrSQL = StrSQL & " FROM [" & SH.Name & "$A" & SH1.Range("B1").Value & ":HZ]"
SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
Rem 粘贴到汇总表中
LASTROW = SH1.Range("A1048576").End(3).Row + 1
SH1.Range("A" & LASTROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
Next
WB.Close False '//关闭打开的工作簿
|
-
运行时错误
|