|
|
Sub ADO法()
t1 = Timer
Dim cnn As Object, rs As Object, rst As Object, SQL$, Mypath$, MyFile$, s$, t$, a, arr, i&, v$
Application.ScreenUpdating = False
Dim objWMI As Object
Const HKEY_LOCAL_MACHINE = &H80000002
Set objWMI = GetObject("winmgmts:\\.\root\default:StdRegProv")
arr = Range("A1:G2") '查询条件区域
For i = 1 To UBound(arr, 2)
If arr(2, i) <> "" Then t = t & " and " & arr(1, i) & "='" & arr(2, i) & "'"
Next
If t = "" Then Exit Sub
t = Mid(t, 5)
Range("A4:I" & Rows.Count).ClearContents '修改清除范围
If Application.Version < 12 Then
v = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='excel 8.0;imex=1';Data Source="
objWMI.SetDWORDValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Jet\4.0\Engines\Excel", "TypeGuessRows", 0
Else
v = "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties='excel 12.0;imex=1';Data Source="
objWMI.SetDWORDValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Office\" & Application.Version & "\Access Connectivity Engine\Engines\Excel", "TypeGuessRows", 0
End If
On Error Resume Next
Mypath = ThisWorkbook.Path & "\"
MyFile = Dir(Mypath & "*.xls*")
Do While MyFile <> ""
If InStr(MyFile, ThisWorkbook.Name) = 0 Then
Set cnn = CreateObject("adodb.connection")
cnn.Open v & Mypath & MyFile
Set rs = cnn.OpenSchema(20)
Do Until rs.EOF
If rs.Fields("TABLE_TYPE") = "TABLE" Then
s = Replace(rs("TABLE_NAME").Value, "'", "")
If Right(s, 1) = "$" Then
Set rst = cnn.Execute("[" & s & "a1:a]") '数据源开始单元格位置
If Err.Number = 0 Then
If rst.Fields(0).Name = "组织" Then '更改起始字段
'SQL = "select * from [" & s & "a1:G8000] where" & t
SQL = "select 组织,成本域名称,料号,品名,规格,库存主单位名称,结存单价,'" & Replace(MyFile, ".xls", "") & "','" & Replace(s, "$", "") & "' from [" & s & "a1:G8000] where" & t '数据工作薄工作表查询范围设定
Set rst = cnn.Execute(SQL)
If Not rst.EOF Then Range("a" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset rst
End If
Else
Err.Clear
End If
End If
End If
rs.MoveNext
Loop
End If
MyFile = Dir()
Loop
rs.Close
Set rs = Nothing
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Application.ScreenUpdating = True
MsgBox "耗时：" & Format(Timer - t1, "0.00") & "秒！" & Chr(10) & "共有“" & [a1048576].End(3).Row - 3 & "”条记录！", vbInformation, "完工"
End Sub
|
|
楼主: chengshanming
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2016-1-20 20:25
楼主
