Question

我有一些代码，我已经使用了一段时间将数据从Oracle数据库提取到Excel，但是如果只返回1行，我现在收到错误。正在使用的SQL很好，但我收到错误＆＃34;错误9：下标超出范围＆＃34;每当返回一行时。任何帮助将不胜感激。

Sub TFD()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Dim mtxData As Variant

' Clear the current list on Sheet7
Sheet7.Range("A2:C1000").ClearContents

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

' Connection string to connect to database
cn.Open ("Provider=OraOLEDB.Oracle;Data Source=(DESCRIPTION=(CID=XXX)(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=XXXXXXXX.XXX.XXXXXX.XXX)(PORT=1521)))(CONNECT_DATA=(SID=XXX)(SERVER=DEDICATED)));User Id=XXXXXXXX;Password=XXXXXXXX")

' Request list of project and database names from database
rs.Open Sheet6.Range("TFD_SQL").Value, cn
    If rs.EOF Then
        Exit Sub
    Else
        With Sheet7
            col = 0
            'First Row: names of columns
            Do While col < rs.Fields.Count
                .Cells(1, col + 1) = rs.Fields(col).Name
                col = col + 1
            Loop
            mtxData = Application.Transpose(rs.GetRows)
            .Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
        End With
    End If

' Close the record set
rs.Close

' Close the database connection
cn.Close

Exit Sub

Answer 1

您的错误＆＃34;错误9：下标超出范围＆＃34;意味着您正在尝试访问阵列中不存在的内容。数组mtxData可能只有一个维度，而不是两个维度。

该行

.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData

正在尝试测量mtxData的第1维和第2维的大小。如果mtxData只有一个维度，那么UBound(mtxData,2)和LBound(mtxData,2)都会抛出此错误。

以下是一种避免此错误的方法......

如果您的Dim语句是，请添加以下行：

Dim NumRows As Long, NumCols As Long

替换这行代码：

.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData

使用以下行：

NumRows = 0
NumCols = 0

On Error Resume Next
NumRows = UBound(mtxData, 1) - LBound(mtxData, 1) + 1
NumCols = UBound(mtxData, 2) - LBound(mtxData, 2) + 1
On Error GoTo 0

If NumRows = 0 Then NumRows = 1
If NumCols = 0 Then NumCols = 1

.Range("A2").Resize(nRows, nCols) = mtxData

语句On Error Resume Next禁止VBA在发生错误时暂停。但是，如果UBound(mtxData,2)是错误，则不会计算NumCols的值，并且该值仍为0.

使用lbound / ubound时出错，具体取决于返回的行数

1 个答案: