EXCEL提取指定目录下的表格数据

Dim k As Integer
Sub 文件名遍历()
Dim str As String
str = Dir(“d:\ID1019*.xls*”)
For i = 1 To 2000
Range(“a” & i + 1) = str
str = Dir
If str = “” Then
Exit For
End If
Next
Call gaiming
End Sub
Sub gaiming()
For k = 2 To Sheet1.Range(“a65536”).End(xlUp).Row
On Error Resume Next
Name “d:\ID1019” & Sheet1.Range(“a” & k) As “d:\ID1019” & “使用中.xls”
Call 抓取
Next
MsgBox “数据提取完成，请给分，谢谢！”
End Sub
Sub 抓取()
Dim conn As New ADODB.Connection
conn.Open “Provider = Microsoft.ACE.OLEDB.12.0;Data Source=d:\ID1019\使用中.xls;extended properties=”“excel 12.0;HDR=YES”“”
Sheet2.Range(“a2”).CopyFromRecordset conn.Execute(“select*from [Report$]”)
conn.Close
Call xieru
End Sub
Sub xieru()
Sheet1.Range(“b” & k) = Sheet2.Range(“e4”)
Sheet1.Range(“c” & k) = Sheet2.Range