根据本文件夹下其他工作簿多个表区域的多列区域查询求和，本文件夹下其他工作簿的每个工作簿的第B\C\D列 25行查询求和。
Dim cn As Object, f$, arr&(1 To 25, 1 To 3), i%
Application.ScreenUpdating = False
Set cn = CreateObject("adodb.connection")
f = Dir(ThisWorkbook.Path & "\*.xls")
Do While f <> ""
If f <> ThisWorkbook.Name Then
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.Path & "\" & f
Range("b6").CopyFromRecordset cn.Execute("select f2,f3,f4 from [基表3$a6:e65536]")
cn.Close
For i = 1 To 25
For j = 1 To 3
arr(i, j) = arr(i, j) + Cells(i + 5, j + 1)
Next j
Next i
End If
f = Dir
Loop
Range("b6").Resize(UBound(arr), 3) = arr
Application.ScreenUpdating = True