[Oracle]VBAからSELECT文を実行しデータを取得する方法

VBAからOracleデータベースでSELECT文を実行してデータを取得するライブラリを作成しましたので記載します。

Oracle接続にはOracle Clientのインストールと参照設定が必要になりますので、過去の記事を参考に設定してください。

エクセルなどのOfficeソフトからADO(ActiveX Data Objects)を使用して、Oracleに接続する方法を記載します。参照設定最初にADOを使用するための参照設定を行います。-をクリックします。参照可能なライブラリファイルから「Microsoft ActiveX Data Objects X.X Library」を選択します。 icon-check-square-o ADOのバージョンはOSなどの環境によって異なります。接続文字列一覧ADOからOracleへ接続するインターフェースにはOLE DBやODBCなどがありますが、ここではOLE DBでの接続文字列を記載します。Oracle社製のOLE DBを使用す...

Oracle接続情報の設定

Oracleへの接続は、TNSサービス名で接続する場合とTNSサービス名を使用せず直接接続する場合の２パターン用意しています。

どちらかの接続方法を選択してヘッダ部に定義してある定数を変更します。

'TNSサービス名で接続する場合(tnsnames.ora)
Private Const PROVIDER As String	= "OraOLEDB.Oracle"
Private Const DATA_SOURCE As String	= "orcl"		'ネットサービス名

'TNSサービス名を使用せず直接接続する場合
Private Const HOST_NAME As String	= "localhost"	'データベースのホスト名orIPアドレス 
Private Const PORT_NO	As String	= "1521"		'データベースのポート
Private Const SERVICE_NAME As String = "orcl"		'サービス名

'データベースのアカウント情報
Private Const USER_ID As String		= "user"		'データベースのユーザID
Private Const PASSWORD As String	= "password"	'データベースのパスワード

TNSサービス名を使用せず直接接続する場合は、本体部分のコードを以下のように変更します。

'	'TNSサービス名で接続する場合
'	cn.ConnectionString	= "Provider=" & PROVIDER _
'						& ";Data Source=" & DATA_SOURCE _
'						& ";User ID=" & USER_ID _
'						& ";PASSWORD=" & PASSWORD
'	cn.Open

	'TNSサービス名を使用せず直接接続する場合
	cn.ConnectionString	= "Provider=" & PROVIDER _
						& ";Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)" _
						& "(HOST=" & HOST_NAME & ")" _
						& "(PORT=" & PORT_NO & "))" _
						& "(CONNECT_DATA=" _
						& "(SERVICE_NAME=" & SERVICE_NAME & ")))" _
						& ";User ID=" & USER_ID _
						& ";PASSWORD=" & PASSWORD
	cn.Open

呼出元の設定

呼出元ではライブラリに渡す引数の設定を行います。

第１引数には、実行したいSELECT文を定義します。

第２引数には、SELECT文を実行して取得したデータを格納する配列を定義します。

配列の要素数はライブラリ内で再定義しますので、動的配列として宣言します。

Dim sql As String
sql = "select * from dual"
Dim dataArray() As Variant
ExecDBSelect(sql, dataArray)

取得データの取り出し

ライブラリの戻り値には、実行結果のステータスコードとして正常に終了した場合はTrue、異常終了した場合はFalseを設定しています。

取得データは引数として渡した配列に２次元配列として格納されています。

実行結果が正常終了の場合のみ、取得データを１要素ずつ取り出してシートに書き出しています。

If ExecDBSelect(sql, dataArray) Then
    Dim y As Integer, x As Integer
    For y = LBound(dataArray, 1) To UBound(dataArray, 1)
        For x = LBound(dataArray, 2) To UBound(dataArray, 2)
            ActiveSheet.Cells(y + 1, x + 1) = (dataArray(y, x))
        Next
    Next
End If

OracleデータベースでSELECT文を実行するライブラリ

最後にライブラリのコードを記載します。

Option Explicit

'TNSサービス名で接続する場合(tnsnames.ora)
Private Const PROVIDER As String	= "OraOLEDB.Oracle"
Private Const DATA_SOURCE As String	= "orcl"		'ネットサービス名

'TNSサービス名を使用せず直接接続する場合
Private Const HOST_NAME As String	= "localhost"	'データベースのホスト名orIPアドレス 
Private Const PORT_NO	As String	= "1521"		'データベースのポート
Private Const SERVICE_NAME As String = "orcl"		'サービス名

'データベースのアカウント情報
Private Const USER_ID As String		= "user"		'データベースのユーザID
Private Const PASSWORD As String	= "password"	'データベースのパスワード

'----------------------------------------------------------------------------------------------------
'	関数名	:	ExecDBSelect
'	機能	:	OracleデータベースでSELECT文を実行してデータを取得する
'	引数	:	sSQL	SELECT文
'			:	vArray	取得データ格納配列
'	戻り値	:	True:正常終了	False:異常終了
'	備考	:
'----------------------------------------------------------------------------------------------------
Public Function ExecDBSelect(sSQL As String, vArray() As Variant) As Integer
	On Error GoTo ERR_HANDLER
	ExecDBSelect = False

	'--------------------------------
	' データベース接続				
	'--------------------------------
	Dim cn As New ADODB.Connection

	'TNSサービス名で接続する場合
	cn.ConnectionString	= "Provider=" & PROVIDER _
						& ";Data Source=" & DATA_SOURCE _
						& ";User ID=" & USER_ID _
						& ";PASSWORD=" & PASSWORD
	cn.Open

'	'TNSサービス名を使用せず直接接続する場合
'	cn.ConnectionString	= "Provider=" & PROVIDER _
'						& ";Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)" _
'						& "(HOST=" & HOST_NAME & ")" _
'						& "(PORT=" & PORT_NO & "))" _
'						& "(CONNECT_DATA=" _
'						& "(SERVICE_NAME=" & SERVICE_NAME & ")))" _
'						& ";User ID=" & USER_ID _
'						& ";PASSWORD=" & PASSWORD
'	cn.Open

	'--------------------------------
	' SQLの実行
	'--------------------------------
	Dim rs As New ADODB.Recordset
	'レコード件数の取得ため、CursorTypeにadOpenStaticを指定する
	rs.Open sSQL, cn, adOpenStatic

	'--------------------------------
	' 取得データを配列に格納
	'--------------------------------
	'配列を再定義する
	Redim vArray(rs.Fields.Count - 1, rs.RecordCount - 1)
	'レコードセットの内容を配列に格納
	vArray = rs.GetRows

	'--------------------------------
	' データベース切断
	'--------------------------------
	If Not rs Is Nothing Then
    	If rs.State = adStateOpen Then rs.Close
		Set rs = Nothing
  	End If 
	If Not cn Is Nothing Then
		If cn.State = adStateOpen Then cn.Close
		Set cn = Nothing
	End If 

	'戻り値設定
	ExecDBSelect = True

Exit Function

ERR_HANDLER:

	'エラーメッセージ
	Debug.Print Err.Number & ")" & Err.Description

	'--------------------------------
	' データベース切断
	'--------------------------------
	If Not rs Is Nothing Then
    	If rs.State = adStateOpen Then rs.Close
		Set rs = Nothing
  	End If 
	If Not cn Is Nothing Then
		If cn.State = adStateOpen Then cn.Close
		Set cn = Nothing
	End If 

End Function

呼出元のサンプルコードを記載します。

Sub main()
    Dim sql As String
    sql = "select * from dual"

    Dim dataArray() As Variant
    Dim y As Integer, x As Integer
    If ExecDBSelect(sql, dataArray) Then
        For y = LBound(dataArray, 1) To UBound(dataArray, 1)
            For x = LBound(dataArray, 2) To UBound(dataArray, 2)
                ActiveSheet.Cells(y + 1, x + 1) = (dataArray(y, x))
            Next
        Next
    End If
End Sub