VBA+SQL提数无数据赋值数组出错

xyd617

代码如下：多工作簿提取数字，但是有些工作簿不满足条件，取不到数字，无法忽略，导致出错，3021 如何解决？


Sub zd2() '2-2?????????

Dim cnn As Object
Dim sql$, mypath$, myname$
Dim arr, brr(1 To 100000, 1 To 9) '16?????????????????????????
Dim rs As Object
Application.ScreenUpdating = False
Set cnn = CreateObject("ADODB.Connection")
mypath = ThisWorkbook.Path & "\"
myname = Dir(mypath & "*.xl*")
Do While myname <> ""
  If myname <> ThisWorkbook.Name Then
    a = Split(myname, ".")(0)
    n = n + 1
    If n = 1 Then
      cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='Excel 12.0;hdr=NO';data source=" & mypath & myname
    Else
      t = "[Excel 12.0;hdr=NO;Database=" & mypath & myname & ";]."
    End If
    sql = "select iff([F1] is null,"",F1),F2,F3,F4,F5,F6,F41,F42 from " & t & "[?????????$A9:BF208] where left(F1,2)<>'???'" '????????????
    Set rs = cnn.Execute(sql)
    arr = rs.GetRows
    For i = 0 To UBound(arr, 2)
      M = M + 1
      brr(M, 1) = a
      For j = 0 To 7 '14???16-2??
         brr(M, j + 2) = arr(j, i)
      Next
    Next
  End If
  myname = Dir()
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Sheets("2-2?????????").Range("a4:i100000") = "" '?????????????????
Sheets("2-2?????????").Range("a4").Resize(M, 9) = brr '16?????????????????????????
Application.ScreenUpdating = True
End Sub

LMY123

Sub 无级_同夹_多薄_指定表_合并成一薄一表_单条件筛选_ADO加数组法() '2-2增值税计算表
    Dim 记录数组, 结果数组(1 To 100000, 1 To 9) '16表示需提取的数据列数，需修改
    Application.ScreenUpdating = False
    Set 连接 = CreateObject("ADODB.Connection")
    路径 = ThisWorkbook.Path & "\"
    外薄 = Dir(路径 & "*.xl*")
    Do While 外薄 <> ""
        If 外薄 <> ThisWorkbook.Name Then
            外薄名无后缀 = Split(外薄, ".")(0)
            外薄计数器 = 外薄计数器 + 1
            If 外薄计数器 = 1 Then
                连接.Open "provider=microsoft.ace.oledb.12.0;extended properties='Excel 12.0;hdr=NO';data source=" & 路径 & 外薄
            Else
                路径及外薄 = "[Excel 12.0;hdr=NO;Database=" & 路径 & 外薄 & ";]."
            End If
            sql = "select F1,F2,F3,F4,F5,F6,F41,F42 from " & 路径及外薄 & "[增值税计算表$A9:BF208] where F1 IS NOT NULL" '数据源表需修改
            Set 记录 = 连接.Execute(sql)
            记录数组 = 记录.GetRows
            For 行 = 0 To UBound(记录数组, 2)
                If InStr(记录数组(o, 行), "项目") Then
                    计数器 = 计数器 + 1
                    结果数组(计数器, 1) = 外薄名无后缀
                    For 列 = 0 To 7 '14表示16-2列
                        结果数组(计数器, 列 + 2) = 记录数组(列, 行)
                    Next
                End If
            Next
        End If
        外薄 = Dir()
    Loop
    记录.Close: Set 记录 = Nothing
    连接.Close: Set 连接 = Nothing
    Sheets("2-2增值税计算表").Range("a4:i100000") = "" '数据清空，区域需修改
    Sheets("2-2增值税计算表").Range("a4").Resize(计数器, 9) = 结果数组 '16表示需提取的数据列数，需修改
    Application.ScreenUpdating = True
End Sub

opiona

http://club.excelhome.net/thread-1409141-1-1.html

cui26896

opiona 发表于 2018-12-15 13:40
http://club.excelhome.net/thread-1409141-1-1.html

老师的贴很热，我认真地读取过，有诸多不明白的地方，不知道能不能加老师的QQ向老师请教，可以的话，请老师回复，在老师同意的前题下，再向老师申请。

opiona

欢迎一起交流一下