【VBA】ExcelにDB接続

'#######################################
'ExcelDB化接続
'【概要】
'       DB接続
'【引数】
'            ExcelPath                  ：接続先Excelのフルパス
'   [省略可] HeaderExists               ：ヘッダ有:True(既定値)、無:False）
'【戻り値】
'            Boolean                    ：True：正常終了   False：異常終了
'#######################################
Function ExcelDBconnect( _
                       ByRef ExcelPath As String _
            , Optional ByRef HeaderExists As Boolean = True _
        ) As Boolean
    On Error GoTo Catch
    
    Const adOpenKeyset = 1
    Const adLockReadOnly = 1
     
    Dim cn As Object
    Dim strSQL As String    'SQL文字列
    Dim fso As Object       'File System Object
    Dim wsh As Variant      'Windows Scripting Host
    
    ExcelDBconnect = False
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wsh = CreateObject("WScript.Shell")
     
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    cn.Provider = "Microsoft.ACE.OLEDB.12.0"
    
    'ファイルが存在しない場合、処理終了
    If fso.FileExists(ExcelPath) = False Then
        MsgBox "対象ファイルが存在しません。ファイルを確認してください" & vbCrLf & ExcelPath
        GoTo Finally
    End If
    
    '接続プロパティ
    'HDR=YES    1行目がヘッダになる
    'HDR=NO     F1,F2,F3・・・と番号が振られる。
    cn.Properties("Extended Properties") = "Excel 12.0;HDR=" & IIf(HeaderExists, "YES", "NO") & ";IMEX=1"
     
    cn.Open ExcelPath '接続
    
    '接続状況をチェック
    If cn.State = adStateOpen Then
        Debug.Print "■接続成功■" & vbTab & ExcelPath
    Else
        Debug.Print "■接続失敗■" & vbTab & ExcelPath
        GoTo Finally
    End If
    
    ExcelDBconnect = True
    
    GoTo Finally
Catch:
    ExcelDBconnect = False
    Debug.Print "■エラー【ExcelDBconnect】" & vbCrLf & Err.Number & vbTab & Err.Description
    MsgBox "エラーが発生しました", , "エラー"
Finally:
    If Not fso Is Nothing Then Set fso = Nothing    '不要オブジェクト開放
    If Not wsh Is Nothing Then Set wsh = Nothing    '不要オブジェクト開放
End Function

シンプルな設定

Private Const DBプロバイダ As String = "Microsoft.ACE.OLEDB.12.0"
Private Const DBプロパティ As String = "Extended Properties"
Private Const DBExcelバージョン As String = "Excel 12.0"

シンプルに接続

Private Function DB接続処理( _
               ByRef DB接続情報 As Object _
             , ByRef レコードセット As Object _
             , ByRef 接続先ファイルのフルパス As String _
             ) As Boolean
    
    On Error GoTo ■エラー処理
    
    DB接続処理 = False
    
    Set DB接続情報 = CreateObject("ADODB.Connection")
    Set レコードセット = CreateObject("ADODB.Recordset")
    
    With DB接続情報
        .Provider = DBプロバイダ
        .Properties(DBプロパティ) = DBExcelバージョン
        .Open 接続先ファイルのフルパス
    End With
    
    Debug.Print "●DB接続処理の成功●"
    DB接続処理 = True
    
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲DB接続処理のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:

End Function

シンプルに切断

Private Function DB切断処理( _
                      ByRef DB接続情報 As Object _
                    , ByRef レコードセット As Object _
                    ) As Boolean
    
    On Error GoTo ■エラー処理
    
    DB切断処理 = False
    
    If Not レコードセット Is Nothing Then
        If レコードセット.State = adStateOpen Then レコードセット.Close
        Set レコードセット = Nothing
    End If
    
    If Not DB接続情報 Is Nothing Then
        If DB接続情報.State = adStateOpen Then DB接続情報.Close
        Set DB接続情報 = Nothing
    End If
    
    Debug.Print "●DB切断処理の成功●"
    DB切断処理 = True
    
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲DB切断処理のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:

End Function