|
原帖由 hhaa999 于 2011-4-6 12:56 发表
工作表名一改变,就出现错误,是不是以工作表名的第一个字符为选择,如果改变了又如何呢,请老师解惑
这个附件不同于上面的,工作表名没有规律了,上面的工作表名就是工作簿名
还有就是表头(或字段)不能是空的
Sub Macro1() '引用Microsoft AD0 Ext 2.8 for DDL and Security
Dim cnn As Object, rs As Object, SQL$, Mypath$, MyFile$, n%, f$, s$
Dim cat As New ADOX.Catalog, tb1 As Table
Set cnn = CreateObject("adodb.connection")
Mypath = ThisWorkbook.Path & "\DD-0\"
MyFile = Dir(Mypath & "*.xls")
Do While MyFile <> ""
n = n + 1
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & Mypath & MyFile
For Each tb1 In cat.Tables
If tb1.Type = "TABLE" Then
s = Replace(tb1.Name, "'", "")
If Right(s, 1) = "$" Then
If n = 1 Then
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath & MyFile
Set rs = cnn.Execute("[" & s & "]")
f = rs.Fields(1).Name
SQL = "select * from [" & s & "] where " & f & ">=100"
Else
SQL = SQL & " union all select * from [Excel 8.0;Database=" & Mypath & MyFile & "].[" & s & "] where " & f & ">=100"
End If
End If
End If
Next
MyFile = Dir()
Loop
[a2].CurrentRegion.ClearContents
[a2].CopyFromRecordset cnn.Execute(SQL)
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub |
评分
-
1
查看全部评分
-
|