ExcelVBA

Excel VBAでOracle接続するプログラムを作成してみた

今回は、Excel VBAでOracleに接続し、指定したSELECT文のデータを取得するプログラムを作成してみたので、そのサンプルプログラムを共有する。

前提条件

下記記事の設定が完了していること。

Excel VBAでOracle接続するプログラムを作成する準備をしてみたExcel VBAでOracleに接続するプログラムを作成することができるが、そのために、いろいろ準備が必要である。今回は、その準備を行...

また、以下のように、接続先となるデータベースに、user_dataテーブルのデータが存在し、user_data2テーブルが存在しないこと
user_data

user_data2



freelance hubを利用して10万件を超える案件情報からJava Spring案件を検索してみたfreelance hubは、レバテックフリーランスやフリエン(furien)を始めとした多くのフリーランスエージェントの案件をまとめて...

サンプルプログラムの作成

ファイル「DbDump.xlsm」を開き、実行情報シートを以下のように編集する。
DbDumpマクロ_フォーマット

また、「取得」ボタンが押下された場合、以下のプログラムの「dbDump」サブプロシージャが呼び出されるようになっていて、チェック処理、DB接続処理、SQL実行、DB切断処理の順に処理を行っている。

Option Explicit  '変数の宣言を必須にする

'-----------------------------------------------------------
' 機能: DBダンプを取得する
' 引数: なし
' 返り値: なし
'-----------------------------------------------------------
Sub dbDump()
    '変数宣言
    Dim ADOConnection As ADODB.Connection
    Dim sSQL As String
    Dim lnSqlIdx As Long
    Dim sWorkSheetName As String
    Dim lnLstRow As Long
    Dim blSqlResult As Boolean
    
    '入力チェックを行う
    If chkInput() = False Then
        Exit Sub
    End If
    
    'DBに接続
    Set ADOConnection = connectDB()
    
    'DBに接続できなければ、処理を終了
    If ADOConnection Is Nothing Then
        Exit Sub
    End If
    
    '実行SQL文を生成
    sSQL = getSQL()
    
    'ワークシート名を取得し、再作成
    sWorkSheetName = Worksheets("実行情報").Cells(12, 4).Value
    Call addWorkSheet(sWorkSheetName)
    
    'SQL実行結果を記載
    blSqlResult = writeSqlResult(sSQL, sWorkSheetName, 2, ADOConnection)
        
    'DBから切断
    Call disConnectDB(ADOConnection)
        
    'SQL実行結果記載処理でエラーがなければ、実行情報シートを
    'アクティブにし、完了メッセージを表示
    If blSqlResult = True Then
        Worksheets("実行情報").Activate
        MsgBox "DBダンプ取得処理が完了しました"
    End If

End Sub

'-----------------------------------------------------------
' 機能: 「実行情報」シートの入力チェック処理を行う
' 引数: なし
' 返り値: 処理結果(True:エラー無、False:エラー有)
'-----------------------------------------------------------
Function chkInput() As Boolean
    'SIDが未入力の場合はエラー
    If Worksheets("実行情報").Cells(5, 3).Value = "" Then
        MsgBox "SIDを入力してください"
        chkInput = False
        Worksheets("実行情報").Cells(5, 3).Select
        Exit Function
    End If
    
    'ユーザーIDが未入力の場合はエラー
    If Worksheets("実行情報").Cells(6, 3).Value = "" Then
        MsgBox "ユーザーIDを入力してください"
        chkInput = False
        Worksheets("実行情報").Cells(6, 3).Select
        Exit Function
    End If
    
    'パスワードが未入力の場合はエラー
    If Worksheets("実行情報").Cells(7, 3).Value = "" Then
        MsgBox "パスワードを入力してください"
        chkInput = False
        Worksheets("実行情報").Cells(7, 3).Select
        Exit Function
    End If

    '取得タイミングが未入力の場合はエラー
    If Worksheets("実行情報").Cells(5, 7).Value = "" Then
        MsgBox "取得タイミングを入力してください"
        chkInput = False
        Worksheets("実行情報").Cells(5, 7).Select
        Exit Function
    End If
    
    'テーブル名が未入力の場合はエラー
    If Worksheets("実行情報").Cells(12, 4).Value = "" Then
        MsgBox "テーブル名を入力してください"
        chkInput = False
        Worksheets("実行情報").Cells(12, 4).Select
        Exit Function
    End If
    
    chkInput = True
    
End Function

'-----------------------------------------------------------
' 機能: DB接続を行う
' 引数: なし
' 返り値: DB接続コネクション
'-----------------------------------------------------------
Function connectDB() As ADODB.Connection
   '変数定義
   Dim sId As String
   Dim sUser As String
   Dim sPass As String
   Dim ADOConnection As ADODB.Connection
   
   'DB接続情報
   sId = Worksheets("実行情報").Cells(5, 3).Value     'SID
   sUser = Worksheets("実行情報").Cells(6, 3).Value   'ユーザーID
   sPass = Worksheets("実行情報").Cells(7, 3).Value   'パスワード
   
   'DB接続
   On Error GoTo ErrOpenDb
   Set ADOConnection = New ADODB.Connection
   ADOConnection.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" _
                   & sId & ";User ID=" & sUser & ";Password=" & sPass & ";"
   ADOConnection.Open
   
   Set connectDB = ADOConnection
   
   Exit Function
   
ErrOpenDb:
   'エラー時は、エラーメッセージを表示
   MsgBox "エラーが発生しました" _
               & vbCrLf & vbCrLf & Err.Description
               
   Set connectDB = Nothing
   
End Function

'---------------------------------------------------------------
' 機能: 実行情報シートの実行SQLで指定された行のSQL文を生成する
' 引数: なし
' 返り値: 生成されたSQL文
'---------------------------------------------------------------
Function getSQL() As String
    '変数定義
    Dim sTblName As String
    Dim sWhere As String
    
    'テーブル名とWhere句を取得
    sTblName = Worksheets("実行情報").Cells(12, 4).Value
    sWhere = Worksheets("実行情報").Cells(12, 6).Value
    
    'SELECT文を生成
    getSQL = "select * from " & sTblName
    If sWhere <> "" Then
        getSQL = getSQL & " where " & sWhere
    End If
    
End Function

'----------------------------------------------------------------------
' 機能: 指定されたシート名のワークシートを再作成する
' 引数: sWorkSheetName : シート名
' 返り値:   なし
'----------------------------------------------------------------------
Sub addWorkSheet(sWorkSheetName As String)
    '指定したシートが存在する場合は削除
    Call deleteWorkSheet(sWorkSheetName)
    
    '指定したシートを追加
    Worksheets().Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = sWorkSheetName
    ActiveSheet.Cells.Select
    Selection.NumberFormatLocal = "@"  '書式は文字列を指定
    Range("A1").Select
    
End Sub

'----------------------------------------------------------------------
' 機能: 指定されたシート名のワークシートを削除する
' 引数: sWorkSheetName : シート名
' 返り値:   なし
'----------------------------------------------------------------------
Sub deleteWorkSheet(sWorkSheetName As String)
    '変数定義
    Dim ws As Worksheet
    
    '指定したシートが存在するかどうかチェック
    '指定したシートが存在する場合は、削除確認メッセージを非表示にして削除
    For Each ws In Sheets
        If ws.Name = sWorkSheetName Then
           Application.DisplayAlerts = False
           Worksheets(sWorkSheetName).Delete
           Application.DisplayAlerts = True
           Exit For
        End If
    Next
    
End Sub

'------------------------------------------------------------------
' 機能: 引数で指定したSQL文の実行結果を出力する
' 引数: sSQL           : 実行するSQL行
'       sWorkSheetName : ワークシート名
'       lnFstRow       : 記載開始行
'       ADOConnection  : DB接続コネクション
' 返り値: 処理結果(True:エラー無、False:エラー有)
'------------------------------------------------------------------
Function writeSqlResult(sSQL As String, sWorkSheetName As String _
                 , lnFstRow As Long, ADOConnection As ADODB.Connection) As Boolean
   '変数定義
   Dim sEvent As String
   Dim sInstance As String
   Dim sUser As String
   Dim sPassword As String
   Dim ADORecordset As New ADODB.Recordset
   Dim myRS As New ADODB.Recordset
   
   Dim inFldCnt As Integer
   Dim lnRowCnt As Long
   Dim i As Long
   
   'SQLの実行
   On Error GoTo ErrExecSelect
   ADORecordset.Open sSQL, ADOConnection
   
   'アクティブシートをテーブル名のシートに設定
   Worksheets(sWorkSheetName).Activate
   
   '実行タイミングをワークシートに追記し、セル結合
   sEvent = Worksheets("実行情報").Cells(5, 7).Value
   Cells(lnFstRow, 1) = "【実行タイミング】" & sEvent
   Range(Cells(lnFstRow, 1), Cells(lnFstRow, 10)).Merge
   
   'SQL文をワークシートに追記し、セル結合
   Cells(lnFstRow + 1, 1) = "SQL: " & sSQL
   Range(Cells(lnFstRow + 1, 1), Cells(lnFstRow + 1, 10)).Merge
   
   'カラム数を取得
   inFldCnt = ADORecordset.Fields.Count
   
   'カラム名を先頭に表示
   For i = 1 To inFldCnt
      Cells(lnFstRow + 2, i).Value = ADORecordset.Fields(i - 1).Name
      Cells(lnFstRow + 2, i).Interior.Color = RGB(0, 32, 96)
      Cells(lnFstRow + 2, i).Font.Color = RGB(255, 255, 255)
   Next
   
   '先頭レコードからEOFまで繰り返し追記
   lnRowCnt = lnFstRow + 3
   Do Until ADORecordset.EOF
       For i = 1 To inFldCnt
          'カラム値を順に表示
          Cells(lnRowCnt, i) = ADORecordset.Fields(i - 1).Value
          Cells(lnRowCnt, i).Interior.Color = RGB(221, 235, 247)
       Next
       ADORecordset.MoveNext
       lnRowCnt = lnRowCnt + 1
   Loop
      
   'ADORecordsetを閉じる
   ADORecordset.Close
   Set ADORecordset = Nothing
   
   '列幅を自動調整する
   Range(Columns(1), Columns(inFldCnt)).EntireColumn.AutoFit
   Range(Columns(11), Columns(14)).EntireColumn.AutoFit
   
   writeSqlResult = True
   Exit Function
   
ErrExecSelect:
   '指定したシートを削除
   Call deleteWorkSheet(sWorkSheetName)
   
   'エラー時は、エラーメッセージを表示
   MsgBox "エラーが発生しました" _
               & vbCrLf & vbCrLf & Err.Description
   writeSqlResult = False
   
End Function

'-----------------------------------------------------------
' 機能: DB切断を行う
' 引数: ADOConnection : DB接続コネクション
' 返り値: なし
'-----------------------------------------------------------
Sub disConnectDB(ADOConnection As ADODB.Connection)
   'DB切断
   If Not (ADOConnection Is Nothing) Then
       ADOConnection.Close
       Set ADOConnection = Nothing
   End If
End Sub

なお、実際に作成したVBAファイルの内容は、以下のサイトを参照のこと。
https://github.com/purin-it/vba/tree/master/excel-vba-oracle

「FlexClip」はテンプレートとして利用できる動画・画像・音楽などが充実した動画編集ツールだったテンプレートとして利用できるテキスト・動画・画像・音楽など(いずれも著作権フリー)が充実している動画編集ツールの一つに、「FlexCli...

サンプルプログラムの実行結果

正常にuser_dataテーブルのデータが取得できる場合の実行結果は、以下の通り。

1-1) 以下のように各セルを指定し、「取得」ボタンを押下
サンプルプログラムの実行結果_1_1

1-2) 以下のように、完了メッセージが表示される
サンプルプログラムの実行結果_1_2

1-3) 「user_data」シートには、以下のように、取得したデータが設定されることが確認できる
サンプルプログラムの実行結果_1_3

また、必須項目(SID)が入力されなかった場合の実行結果は、以下の通り。

2-1) 以下のように、SIDの入力がない状態で、「取得」ボタンを押下
サンプルプログラムの実行結果_2_1

2-2) 以下のように、エラーメッセージが表示されることが確認できるので、「OK」ボタンを押下
サンプルプログラムの実行結果_2_2

2-3) 以下のように、エラーの原因となる項目にカーソルが設定されることが確認できる
サンプルプログラムの実行結果_2_3

さらに、DB接続時にエラーになる場合の実行結果は、以下の通り。

3-1) 以下のように、接続先のうち「パスワード」が違っている状態で、「取得」ボタンを押下
サンプルプログラムの実行結果_3_1

3-2) 以下のように、ログインできなかった旨のエラーメッセージが表示されることが確認できる
サンプルプログラムの実行結果_3_2

また、実行SQLエラーになる場合の実行結果は、以下の通り。

4-1) 以下のように、実行SQLで指定したテーブル名が存在しない状態で、「取得」ボタンを押下
サンプルプログラムの実行結果_4_1

4-2) 以下のように、表(テーブル)が存在しない旨のエラーメッセージが表示されることが確認できる
サンプルプログラムの実行結果_4_2

要点まとめ

  • Excel VBAでOracleに接続するには、ADOというMicrosoftが提唱しているデータアクセス技術を利用して、ADODB.Connectionのオープン(DB接続)→ADORecordsetのオープン(SQL実行)→ADORecordset、ADODB.Connectionのクローズの順に実行すればよい。