提取整列数据

156595311

提取整列数据，只要其中指定列，不是整行提取。

156595311

1. Sub 数据提取()
   
2.     Dim cnn As Object, cat As Object
   
3.     Dim i As Integer
   
4.     Dim Mypath As String, Myfile As String
   
5.     Dim sql As String
   
6.     Dim tb As Object
   
7.     Mypath = ThisWorkbook.Path & ""
   
8.     Myfile = Dir(Mypath & "*.xls")
   
9.     ActiveSheet.UsedRange.Offset(1).ClearContents
   
10.     Set cnn = CreateObject("adodb.connection")
    
11.     Set cat = CreateObject("ADOX.Catalog")
    
12.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath & Myfile
    
13.     Do While Myfile <> ""
    
14.         If Myfile <> ThisWorkbook.Name Then
    
15.             cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & Mypath & Myfile
    
16.             For Each tb In cat.tables
    
17.                 If tb.Type = "TABLE" Then
    
18.                     If tb.Name = "Sheet2$" Then
    
19.                         sql = "select 工号,收入 from[Excel 8.0;Database=" & Mypath & Myfile & "].[" & tb.Name & "a1:o65536]"
    
20.                         [a65536].End(3).Offset(1).CopyFromRecordset cnn.Execute(sql)
    
21.                     End If
    
22.                 End If
    
23.             Next
    
24.         End If
    
25.         Myfile = Dir()
    
26.     Loop
    
27.     Set cat = Nothing
    
28.     cnn.Close
    
29.     Set cnn = Nothing
    
30. End Sub

复制代码

提取得不全的。怎么改好？

156595311

怎么没人理的？要收钱吗？