VBA - OracleへのODBC接続とSELECT文の実行

前提条件

オラクルクライアントのインストール及び設定は完了済みであること。
参考文献-Oracle Database 21c Clientのインストールを試す

Excel側

セル"A1" に SQL SELECT 文を記載。
[SQL実行ボタン]クリック → イベント処理発動。

処理内容

A4行をヘッダー行とし、データは"A5"からスタート。
1000行目以降は、セルへの転記を回避。

Sub テキストボックス1_Click()

    Dim SQL As String
    Dim i As Long
    Dim row As Long
    Dim ws As Worksheet
    Dim dispRowMAX As Long
    Dim overFlag As Boolean

    Const Provider = "OraOLEDB.Oracle" 'Provider
    Const DATA_SOURCE = "hoge"           'Data Source
    Const USER_ID = "hoge"               'userid
    Const Password = "hoge"              'password

    Set ws = ActiveSheet
    SQL = Range("A1").Value
    
    
    'SQL文-空欄チェック
    If SQL = "" Then
        MsgBox "SQL文を指定して下さい。", Buttons:=vbExclamation
        Exit Sub
    End If
    
    Dim conn As New ADODB.Connection
        
    conn.ConnectionString = _
                    "Provider=" & Provider & ";" & _
                    "Data Source=" & DATA_SOURCE & ";" & _
                    "USER ID=" & USER_ID & ";" & _
                    "Password=" & Password & ";"
                    
    conn.CursorLocation = adUseClient
    
    conn.Open
    
    Dim rs As New ADODB.Recordset
    
    Range("A1").CurrentRegion.Offset(3, 0).ClearContents

    rs.Source = SQL
    rs.ActiveConnection = conn
    rs.Open
    
    overFlag = False
    
    If rs.RecordCount > 1000 Then
        MsgBox "1000行を超えています。" & vbCrLf & "1000行目以降は表示しません。", Buttons:=vbExclamation
        dispRowMAX = 1000 + 4
        overFlag = True
    Else
        dispRowMAX = rs.RecordCount
    End If
    
        
    With ws
        
        '列名の表示
        For i = 0 To rs.Fields.Count - 1
            .Cells(4, i + 1) = rs(i).Name
        Next i

        '値の表示
        row = 4
        
        If overFlag = True Then
            Do Until row = dispRowMAX
                For i = 0 To rs.Fields.Count - 1
                    .Cells(row + 1, i + 1) = rs(i).Value
                Next i
                rs.MoveNext
                row = row + 1
            Loop
        Else
            Do Until rs.EOF
                For i = 0 To rs.Fields.Count - 1
                    .Cells(row + 1, i + 1) = rs(i).Value
                Next i
                rs.MoveNext
                row = row + 1
            Loop
        End If
        
    End With
    
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Sub

警告
SELECT文以外のSQL処理も実行可能なはず。
なので、ご注意ください。