#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