【VBA】ExcelのDB化

 #VBA 
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