リフレクション!VB2005からExcelを遅延バインディングで作成する

メモ:  Category:vb

VB2005から遅延バインディングでDataSetからExcelを作成してみます。リフレクションを使ってと言った方がいいのかもしれません。

事前バインディングの場合、バージョンアップによりオブジェクトのバイナリレイアウトが変わる可能性があるため、作成したアプリケーションのインストール先によって、バージョンに関する問題が発生する場合があります。

例えば、ある環境ではExcel2000がインストールされており、別の環境ではExcel2003がインストールされているといった場合です。

この問題を解消するために、実行時にバインディングするようコーディングします。面倒ですが…

この方法は、実行時バインディングとかレイトバインディング、遅延バインディングと呼ばれている方法です。

ここでの方法以外にCreateObjectを使う方法もあるのですが、もうひとつの方法で実装してみます。

DataSetからExcelへ出力

DataSetから項目名及び値を取得し、Excelファイルを作成します。

Public Sub ExportData2Excel(ByRef dtsData As DataSet, ByVal strFile As String)

    ' Excelクラス ProgID に関連付けられている型を取得
    Dim typClassType As Type = Type.GetTypeFromProgID("Excel.Application")

    Dim objApp As New Object
    Dim objBooks As Object
    Dim objBook As Object
    Dim objSheet As Object
    Dim objRang As Object
    Dim objParams() As Object

    ' Excelの型がそれに関連付けられていない。(Excelが存在しない)
    If typClassType Is Nothing Then Return

    ' Excelのインスタンスを作成します。
    objApp = Activator.CreateInstance(typClassType)
    ' Booksオブジェクトの作成
    objBooks = objApp.GetType().InvokeMember("Workbooks", BindingFlags.GetProperty, _
                                              Nothing, objApp, Nothing)
    ' 新規Bookの作成
    objBook = objBooks.GetType().InvokeMember("Add", BindingFlags.InvokeMethod, Nothing, _
                                              objBooks, Nothing)
    ' Activeなシートを取得
    objSheet = objApp.GetType().InvokeMember("ActiveSheet", BindingFlags.GetProperty, _
                                              Nothing, objApp, Nothing)

    Dim intColIndex As Integer = 1      ' セルのポジションColumn
    Dim intRowIndex As Integer = 1      ' セルのポジションRow

    ' データテーブルの取得
    For Each dttTable As DataTable In dtsData.Tables

        ReDim objParams(0)
        objParams(0) = dttTable.TableName
        ' Nameプロパティへテーブル名をセット
        objSheet.GetType().InvokeMember("Name", BindingFlags.SetProperty, Nothing, _
                                        objSheet, Nothing)
        ' 項目名
        For Each dtcField As DataColumn In dttTable.Columns

            ReDim objParams(1)
            objParams(0) = intRowIndex
            objParams(1) = intColIndex
            ' 書き込み先セルを取得
            objRang = objApp.GetType().InvokeMember("Cells", BindingFlags.GetProperty, _
                                                    Nothing, objApp, objParams)

            ReDim objParams(0)
            objParams(0) = dtcField.ColumnName
            ' 項目名を設定
            objRang.GetType().InvokeMember("Value", BindingFlags.SetProperty, _
                                           Nothing, objRang, objParams)
            intColIndex += 1
        Next
        intRowIndex += 1
        ' データの設定
        For Each drwRow As DataRow In dttTable.Rows
            For i As Integer = 1 To dttTable.Columns.Count

                ReDim objParams(1)
                objParams(0) = intRowIndex
                objParams(1) = i
                ' 書き込み先セルを取得
                objRang = objApp.GetType().InvokeMember("Cells", _
                                            BindingFlags.GetProperty, Nothing, objApp, objParams)

                ReDim objParams(0)
                objParams(0) = drwRow.Item(i - 1).ToString
                ' 値を設定
                objRang.GetType().InvokeMember("Value", _
                                   BindingFlags.SetProperty, Nothing, objRang, objParams)

            Next
            intRowIndex += 1
        Next
    Next


    ReDim objParams(0)
    objParams(0) = strFile
    ' 保存
    objSheet.GetType().InvokeMember("SaveAs", BindingFlags.InvokeMethod, _
                                    Nothing, objSheet, objParams)
    ' Excelの終了
    objApp.GetType().InvokeMember("Quit", BindingFlags.InvokeMethod, Nothing, objApp, Nothing)


End Sub

今後、もう少しリフレクションについて掘り下げていきたいです。

bluenote by BBB