AS400にADO接続しSQLでデータを取得するExcelVBA

AS400のフロントエンドとして使う

　AS400からデータを取得できるSQLツールは多いのですが、取得したデータは Excel で処理することが多いでしょう。
　であれば、そもそも Excel でAS400からデータを取得すれば、フロントエンドの使用法をいくつも覚えずに済みます。

先日のお話

　先日の記事( AS400からのデータ転送を行うExcelVBA - 一所懸命に手抜きする )では
1. ユーザーがExcelに条件を選択/記述
2. そこからVBAでデータ転送定義(.TTO)ファイルを生成
3. RTOPCBをバッチファイルで実行
4. 結果はCSVに出力
というデータ転送方法を紹介しました。

今回のお話

　今回の記事では
1. ユーザーがExcelにSQLを記述
2. VBAがADOを介してAS400に接続
3. SQLを実行し
4. 結果をExcel上に獲得
というデータ取得方法を紹介します。

注意

　本記事はAS400へのアクセス権限がない人がAS400に接続できるようにするものではありません。
　システム部門から正当なアクセス権を与えられていて、ODBCなどの設定ができていることが必要です。

You must be granted access permission to AS400 previously.

AS400からADOを介してSQLを実行しAS400からデータを取得するVBA

Using ADO , we can access to AS400 DB2 via SQL with Excel VBA.

Excelの準備

Excelのシート名の変更

　今回、シートを2枚使用します。
　1枚は SQL もう一枚は RES とリネームして下さい。

Prepare 2 sheets on your Excel and rename them as "SQL","RES"

SQL入力画面

　Worksheets("SQL")

　この画像を参考にコマンドボタンを一つ作成して下さい。名前は変更しないで(CommandButton1のままで)おいてください。
　セル B1 はSQLを記載するところです。

Set CommandButton1(the name must be 'CommandButton1') on the sheets("SQL")
Write SQL statement in Sheets("SQL").Range("B1")

VBAをセット

ExcelVBA作成時のVBE準備手順

Module1に下記コードを貼り付けて下さい。

paste this code on module1(on VBE)

ExcelVBA]ADOでAS400に接続してSQLを実行するVBA

Sub CommandButton1_Click()
' a-habakiri 2008,2016  http://a-habakiri.hateblo.jp/ 
  
    Dim cn As Object  ' ADODB.Connection
    Dim rs As Object  ' ADODB.Recordset
    Dim fld As Object ' ADODB.Fields
    Dim strSQL As String
    Dim x, y As Long
    
' Late bind an instance of AS400 via ADODB.
    
    Set cn = CreateObject("ADODB.Connection")
    '                  v-- Rewrite as your own
    cn.Open "Provider=IBMDA400;Data Source=AS400"
    'cn.CursorLocation = adUseServer
    'cn.CursorLocation = adUseClient
    
' Execute SQL and get recordset as a result
    
    strSQL = ThisWorkbook.Worksheets("SQL").Range("b1")
    Set rs = cn.Execute(strSQL)

' Extract recordset into worksheets("RES")
    
    y = 1: x = 1
    ThisWorkbook.Worksheets("RES").Select
With ActiveSheet
        .Cells().Clear
    For Each fld In rs.Fields
        .Cells(y, x) = fld.Name
        x = x + 1
    Next
        y = y + 1
    Do While rs.EOF = False
            x = 1
        For Each fld In rs.Fields
            .Cells(y, x) = fld.Value
            x = x + 1
        Next
            y = y + 1
            rs.MoveNext
    Loop
End With

' Close connection
    
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

  ' Usage( http://a-habakiri.hateblo.jp/ )
  ' 1. prepare 2 sheets on your Excel and rename them as "SQL","RES" 
  ' 2. set CommandButton1 on the sheets("SQL")
  ' 3. paste this code on module1(on VBE)
  ' 4. write SQL at sheets("SQL").Range("B1")
  ' 5. Click CommandButton1 !
  ' 6. SQL Result will be extract on the sheet("RES")
End sub

注意

　1.cn.Open "Provider=IBMDA400;Data Source=AS400"の部分が肝です。
　ここはUID,PWDの設定などを記述できるのですが、セキュリティ上危険です。iSeriesナビゲーターなどで接続している人はそちらの設定を流用できます。
　2.実行時バインド(Late binding)を用いていますので参照設定は不要です。
3.結果表示にはExcel2000以上なら　CopyFromRecordsetが使えます。

Late binding is adopted .

実行結果

　CommandButton1をクリックすると、 　

　Worksheets("RES")

　
　このように RES シートに結果が展開されます。
　TTOで転送したときと違ってヘッダがあります。

Click CommandButton1 !
and VBA executes SQL and get recordset.
SQL Result will be extracted on the sheet("RES")

ExcelをSQLのUIとして使う

　このVBAで使い慣れた Excel がSQLのユーザーインターフェースになります。

　御使用のご感想などがありましたらコメントを頂ければ幸いです。
　 ※本日一時的にGitHubのアカウントがunpublicにされていました。
Gistのコードを貼ってあったのですが、皆さんからは見えなくなっていました。
そのため、はてなのシンタックスハイライトに戻しました。