トップページに戻る

VB.NETメモ


遅延バインドでExcelファイルからのデータ取得

Private Sub ReadExcel()
    Dim ObjExcel As Object = Nothing
    Dim ObjWorkBooks As Object = Nothing
    Dim ObjWorkBook As Object = Nothing
    Dim ObjSheets As Object = Nothing
    Dim ObjSheet As Object = Nothing
    Dim ObjRange1 As Object = Nothing
    Dim ObjRange2 As Object = Nothing
    Dim ObjRange3 As Object = Nothing

    Try
        ObjExcel = CreateObject("Excel.Application")
        ObjWorkBooks = ObjExcel.Workbooks
        ObjWorkBook = ObjWorkBooks.Open(ExcelFileFullPath)
        ObjSheets = ObjWorkBook.Worksheets

        For I = 1 To ObjSheets.Count
            ObjSheet = ObjSheets(1)
            Dim SheetName As String = ObjSheet.Name
            ObjRange1 = ObjSheet.Range("A1:Z65535")
            ObjRange2 = ObjRange1.SpecialCells(11)

            Dim MaxX As Integer = ObjRange2.Column
            Dim MaxY As Integer = ObjRange2.Row

            Dim wkStrRange As String = "A1:"
            wkStrRange &= String.Format("{0}{1}", S01_02_GetA1(MaxX), MaxY)
            ObjRange3 = ObjSheet.Range(wkStrRange)

            Dim ExcelValArr As Object(,) = ObjRange3.Value

            ReleaseObject(ObjRange3)
            ReleaseObject(ObjRange2)
            ReleaseObject(ObjRange1)
            ReleaseObject(ObjSheet)
        Next I
    Finally
        ReleaseObject(ObjRange3)
        ReleaseObject(ObjRange2)
        ReleaseObject(ObjRange1)
        ReleaseObject(ObjSheets)

        'Excelファイルを閉じる
        If IsNothing(ObjWorkBook) = False Then ObjWorkBook.Close(False)

        ReleaseObject(ObjWorkBook)
        ReleaseObject(ObjWorkBooks)

        'Excelを閉じる
        If IsNothing(ObjExcel) = False Then ObjExcel.Quit()
        ReleaseObject(ObjExcel)
    End Try
End Function

'ExcelのR1C1形式の列番号をA1形式の列名称に変換
Private Function S01_02_GetA1(pRetuBangou As Integer) As String
    Dim WillReturn As String = ""
    For I = 1 To pRetuBangou
        If I = 1 Then
            WillReturn = "A"
            Continue For
        End If
        Dim AddPlace As Integer = WillReturn.Length - 1
        Do
            If AddPlace = -1 Then
                WillReturn = "A" + WillReturn
                Exit Do
            End If
            If WillReturn(AddPlace) <> "Z"c Then
                Dim wkStr As String = Chr(Asc(WillReturn(AddPlace)) + 1).ToString
                WillReturn = WillReturn.Insert(AddPlace, wkStr)
                WillReturn = WillReturn.Remove(AddPlace + 1, 1)
                Exit Do
            End If
            If WillReturn(AddPlace) = "Z"c Then
                WillReturn = WillReturn.Insert(AddPlace, "A")
                WillReturn = WillReturn.Remove(AddPlace + 1, 1)
                AddPlace -= 1
                Continue Do
            End If
        Loop
    Next I
    Return WillReturn
End Function

'Excelオブジェクトの解放
Private Sub ReleaseObject(pObj As Object)
    If IsNothing(pObj) = False Then
        Runtime.InteropServices.Marshal.ReleaseComObject(pObj)
        pObj = Nothing
    End If
End Sub