代码出错

xyd617

请教下大神，这个神代码调试出现问题。
1、运行未出错，但提取不到数据。
2、ARR数组行号数确定，列号不确定，列号根据遍历工作簿的数字确定。如何处理？动态数组怎么处理.
3、实现效果，在TT核对工作簿，对文件夹下指定工作簿横向合并，用SQL实现。
Sub hd6() '????
Dim cnn As Object
Dim Sql As String, myf, ARR(1 To 165, 1 To 4, M%'这个4会根据遍历工作簿的数量变动
Set cnn = CreateObject("ADODB.CONNECTION")
myf = Dir(ThisWorkbook.Path & "\*.xls")
Do While myf <> "" And myf <> ThisWorkbook.Name
    cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=NO'; Data Source=" & ThisWorkbook.Path & "\" & myf
    Sql = "select * from [TT.TT006$b7:b170]"
    M = M + 1
    ARR(1, M) = Replace(myf, ".xls", "")
        For n = 2 To 165
            ARR(n, M) = cnn.Execute(Sql)(0)
        Next n
    cnn.Close
    myf = Dir()
Loop
Sheets("TT.TT006").Range("b2:b1000") = ""
Sheets("TT.TT006").Range("b2").Resize(165, M) = ARR
Set cnn = Nothing
End Sub

xyd617

我把HDR=NO  改成 HDR=YES ，可以取数了，但所有区域只取一个数：651532.18

xyd617

顶一下哈  那位大神帮忙看下哈 谢谢了

LMY123

xyd617 发表于 2018-8-6 15:39
顶一下哈  那位大神帮忙看下哈 谢谢了

1. 'http://club.excelhome.net/thread-1145518-1-1.html
   
2. Sub ADO()
   
3.     Dim Fso As Object, File As Object, cnn As Object, SQL$, m&
   
4.     Application.ScreenUpdating = False
   
5.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
6.     ActiveSheet.UsedRange.Offset(2).ClearContents
   
7. '    ActiveSheet.UsedRange.Offset(2, 1).ClearContents
   
8.     For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
   
9.         If File.Name Like "*.xls" And File.Name <> ThisWorkbook.Name Then
   
10.             m = m + 1
    
11.             If m = 1 Then
    
12.                 Set cnn = CreateObject("adodb.connection")
    
13.                 cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no';Data Source=" & File
    
14.                 SQL = "select * from [TT.TT006$A7:b170]"
    
15.                 [a4].CopyFromRecordset cnn.Execute(SQL)
    
16.             Else
    
17.                 SQL = "select * from [Excel 8.0;hdr=no;Database=" & File & ";].[TT.TT006$b7:b170]"
    
18.                 Cells(3, m + 1).CopyFromRecordset cnn.Execute(SQL)
    
19.             End If
    
20.             Cells(2, m + 1) = Replace(File.Name, ".xls", "")
    
21.         End If
    
22.     Next
    
23.     Set Fso = Nothing
    
24.     cnn.Close
    
25.     Set cnn = Nothing
    
26.     Application.ScreenUpdating = True
    
27. End Sub

复制代码