Fehler bei der Verwendung von lbound/ubound abhängig von der Anzahl zurückgegebener Zeilen

Question

Ich habe ein wenig Code, den ich schon seit einiger Zeit verwende, um Daten aus einer Oracle-Datenbank nach Excel zu extrahieren, aber jetzt bekomme ich einen Fehler, wenn nur 1 Zeile wird zurückgegeben. Die SQL, die verwendet wird, ist in Ordnung, aber ich erhalte den Fehler "Fehler 9: Index außerhalb des Bereichs" wann immer eine einzelne Zeile zurückgegeben wird. Jede Hilfe würde sehr geschätzt werden.

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

Ihr Fehler "Error 9: Index out of range" bedeutet, dass Sie etwas in dem Array zuzugreifen versuchen, das gar nicht existiert. Es ist wahrscheinlich, dass das Array mtxData nur eine Dimension hat, nicht zwei.

Die Linie

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

versucht, die die Größe sowohl der 1. und 2. Dimension mtxData zu messen. Wenn mtxData nur eine Dimension hat, wird dieser Fehler von UBound(mtxData,2) und LBound(mtxData,2) ausgelöst.

Unten ist eine Methode, erhalten diesen Fehler zu vermeiden ...

Wo Ihre Dim-Anweisungen, die folgende Zeile hinzufügen:

Dim NumRows As Long, NumCols As Long 

diese Codezeile ersetzen:

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

mit den folgenden Zeilen:

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 

Die Anweisung On Error Resume Next verhindert, dass VBA anhält, wenn ein Fehler auftritt. Wenn UBound(mtxData,2) jedoch ein Fehler ist, wird der Wert von NumCols nicht berechnet und bleibt 0.