Excel VBAでAccessにアクセスする簡単なクラスモジュールの公開 Accessing Access Table with Excel VBA Class Module

Accessにアクセスとは洒落でもなく、あるテーブルをExcelに取り込んで処理することです。

コレ、無駄なようで意外と実務で使う理由は、何と言っても「Excelは軽い」から。ヌルサクだから。Access上でテーブルにフィルターをかける時の遅さ。共有して更新していると重い、ファイルが壊れる。さらに、Accessに拒否反応を示す人の多さ(笑)

ということで、フロントエンドにExcelを使用するための、簡単なクラスモジュールを公開しますので、必要でしたらコピペして使ってみてください。

Have you ever wanted to import Access tables into Excel and process them? You do not need to open the Access application. Just add this code to Excel VBA class module.

クラスモジュール class module

Private DBC As ADODB.Connection

Public Function OpenDatabase(database_filename) As Boolean
    On Error GoTo openError
    Set DBC = New ADODB.Connection
    With DBC
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Data Source").Value = database_filename
        .Open
    End With
    OpenDatabase = True
    Exit Function
 
openError:
    OpenDatabase = False
End Function

Public Function OpenRecordset(com_SQL) As ADODB.Recordset
    On Error GoTo openError 
    Dim open_recordset As New ADODB.Recordset
    With open_recordset
        .ActiveConnection = DBC
        .Source = com_SQL
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .Open
    End With
 
    Set OpenRecordset = open_recordset

openError:
    Set OpenRecordset = Nothing
End Function

標準モジュール（使用例）Examples of using this class module

Public Sub make_form()
       
    Dim my_ado_tool As New ado_tool
    If my_ado_tool.OpenDatabase("C:\database\my_access.accdb") = False Then
        MsgBox "Error: Database could not open."
        Exit Sub
    End If
 
    Dim my_recordset As ADODB.Recordset
    Set my_recordset = my_ado_tool.OpenRecordset("SELECT * FROM phone_calls_KPI_Tohoku;")
 
    If my_recordset Is Nothing Then
        MsgBox "Error: KPI Recordset could not open."
        Exit Sub
    End If

    Application.ScreenUpdating = False
 
    CopyFromRecordset my_recordset, ThisWorkbook.Worksheets("KPI")
 
    Set my_recordset = Nothing
    Set my_ado_tool = Nothing
 
    Application.ScreenUpdating = True

    Msgbox "finished."
 
End Sub

標準モジュール（ADODB.Recordsetのインポート）ADBDB.Recordset copy to Excel Worksheet

Public Function CopyFromRecordset(DBR As ADODB.Recordset, sheet_set As Worksheet)

    Dim cnt_clm
 
    With sheet_set
        .Cells.Clear
        For cnt_clm = 1 To DBR.Fields.Count
            .Cells(1, cnt_clm) = DBR.Fields.Item(cnt_clm - 1).Name
        Next
             
        .Range("A2").CopyFromRecordset DBR

    End With
 
End Function