一所懸命に手抜きする

デスクワークばかりのスポーツ嫌いで50歳も過ぎ、いよいよ足腰に衰えを感じつつある昨今。

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

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

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

先日のお話

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

今回のお話

 今回の記事では
1. ユーザーがExcelSQLを記述
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")

f:id:a_habakiri:20161208222913p:plain:w500
 この画像を参考にコマンドボタンを一つ作成して下さい。名前は変更しないで(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")
 f:id:a_habakiri:20161208225501p:plain
 このように RES シートに結果が展開されます。
 TTOで転送したときと違ってヘッダがあります。
Click CommandButton1 !
and VBA executes SQL and get recordset.
SQL Result will be extracted on the sheet("RES")

ExcelSQLのUIとして使う

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

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