自分用のメモなので、形は整ってないです。
ADOを使ったACCESSのレコードの取得・更新
※ACCESS側でテーブルをデザインビューで開いているとエラーになるので、データシートビューで開くように
Sub Sample1()
'例1
Dim adoCon As Object
Dim adoRs As Object
Dim path As String
Dim sqlStr As String
Dim xRow As Long
path = "C:\work\テスト.accdb"
Set adoCon = CreateObject("ADODB.Connection")
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
sqlStr = "SELECT * FROM 数値 WHERE 整数 > 4000"
Cells.Clear
adoRs.Open sqlStr, adoCon
Cells(1, 1).CopyFromRecordset adoRs
'テーブルのデータを取得し、エクセルに出力
'データが1件も無い場合は、何も出力されない
xRow = 30
With adoRs
On Error Resume Next
'データが1件も無い場合は、MoveFirstでエラーになってしまうので、エラー無視で
.MoveFirst
'先頭のレコードへ移動。一度全レコードの取得しているので、これが必要になる
On Error GoTo 0
Do Until .EOF
Cells(xRow, 1) = !バイト
Cells(xRow, 2) = !整数
Cells(xRow, 3) = !長整数
.MoveNext
xRow = xRow + 1
Loop
End With
sqlStr = "UPDATE 数値 SET 整数 = 999 WHERE 整数 > 50"
adoCon.BeginTrans 'トランザクションの開始
On Error Resume Next
adoCon.Execute sqlStr ' 更新の実行
If Err.number > 0 Then 'エラーが発生している場合
adoCon.RollbackTrans 'ロールバック
Else
adoCon.CommitTrans 'コミット
End If
On Error GoTo 0
On Error Resume Next
adoRs.Close
'すでにCloseしていたり、Openしていない場合はエラーになるので、エラー無視で進めるのが適切か
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
End Sub
Sub Sample2()
'例2
Dim adoCon As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim path As String
Dim sqlStr As String
Dim xRow As Long
Dim i As Long
path = "C:\work\テスト.accdb"
Set adoCon = New ADODB.Connection
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
Set adoRs = New ADODB.Recordset
sqlStr = "SELECT * FROM 数値 WHERE 整数 > 30"
Cells.Clear
adoRs.Open sqlStr, adoCon
xRow = 1
On Error Resume Next
'データが1件も無い場合は、MoveFirstでエラーになってしまうので、エラー無視で
adoRs.MoveFirst
On Error GoTo 0
Do Until adoRs.EOF
For i = 0 To adoRs.Fields.Count - 1
If xRow = 1 Then '1行目はフィールド名も出力
Cells(xRow, i + 1) = adoRs(i).Name
Cells(xRow + 1, i + 1) = adoRs(i).Value
Else
Cells(xRow, i + 1) = adoRs(i).Value
End If
Next i
adoRs.MoveNext
If xRow = 1 Then
xRow = 3
Else
xRow = xRow + 1
End If
Loop
On Error Resume Next
adoRs.Close
'すでにCloseしていたり、Openしていない場合はエラーになるので、エラー無視で進めるのが適切か
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
End Sub
Sub Sample3()
'例3
Dim adoCon As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim path As String
Dim xRow As Long
Dim i As Long
path = "C:\work\テスト.accdb"
Set adoCon = New ADODB.Connection
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
Set adoRs = New ADODB.Recordset
With adoRs
.Source = "数値" 'テーブル名
.ActiveConnection = adoCon
.CursorType = adOpenKeyset 'キーセットカーソルを使用
.LockType = adLockPessimistic 'レコード単位排他的ロック
.Open
End With
Cells.Clear
xRow = 1
On Error Resume Next
'データが1件も無い場合は、MoveFirstでエラーになってしまうので、エラー無視で
adoRs.MoveFirst
On Error GoTo 0
Do Until adoRs.EOF
For i = 0 To adoRs.Fields.Count - 1
If xRow = 1 Then '1行目はフィールド名も出力
Cells(xRow, i + 1) = adoRs(i).Name
Cells(xRow + 1, i + 1) = adoRs(i).Value
Else
Cells(xRow, i + 1) = adoRs(i).Value
End If
Next i
adoRs.MoveNext
If xRow = 1 Then
xRow = 3
Else
xRow = xRow + 1
End If
Loop
adoCon.BeginTrans 'トランザクションの開始
On Error Resume Next
With adoRs
.MoveFirst 'これは必要
.Find "整数 = 50", 0, adSearchForward '整数=50 のレコードへ移動
.Fields("バイト") = 11
.Fields("整数") = 22
.Fields("長整数") = 33
.Fields("単小数") = 44
.Fields("倍小数") = 55
.Fields("十進") = 66
.Fields("大きい数値") = 77
.Fields("通貨") = 88
.Update '更新
'以下のように、ARRAYでまとめて指定して更新することもできる
' .Update Array("整数", "長整数", "単小数"), Array(777, 888, 999)
End With
If Err.number > 0 Then 'エラーが発生している場合
adoCon.RollbackTrans 'ロールバック
Else
adoCon.CommitTrans 'コミット
End If
On Error GoTo 0
On Error Resume Next
adoRs.Close
'すでにCloseしていたり、Openしていない場合はエラーになるので、エラー無視で進めるのが適切か
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
End Sub
ACCESSのテーブル名・クエリ名を取得する
'Microsoft ActiveX Data Objects *,* Library と Microsoft ADO Ext. *.* for DDL and Security が必要になるらしい
Dim adoCon As Object
Dim ac As New ADOX.Catalog
Dim xTable As ADOX.Table
Dim xQuery As ADOX.View
Dim xProcedure As ADOX.Procedure
Dim path As String
path = "C:\Users\Benten\Desktop\ACCESSシステム\システム.accdb"
Set adoCon = CreateObject("ADODB.Connection")
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
ac.ActiveConnection = adoCon
'テーブル。テーブル以外にもパラメータを持たない選択クエリが含まれる
For Each xTable In ac.Tables
Select Case xTable.Type
Case "TABLE"
Debug.Print "通常テーブル: " & xTable.Name
Case "VIEW"
Debug.Print "パラメータ無し選択クエリ: " & xTable.Name
Case "LINK"
Debug.Print "リンクテーブル(ODBC以外): " & xTable.Name
Case "ACCESS TABLE"
Debug.Print "ACCESS システムテーブル: " & xTable.Name
Case "SYSTEM TABLE"
Debug.Print "Microsoft jet システムテーブル: " & xTable.Name
Case "PASS-THROUGH"
Debug.Print "リンクテーブル(ODBC): " & xTable.Name
Case Else
Debug.Print "異常なオブジェクト?" & xTable.Name
End Select
Next xTable
Debug.Print "*****************************************************************************"
'クエリ
For Each xQuery In ac.Views
Debug.Print "パラメータ無し選択クエリ: " & xQuery.Name
Next xQuery
For Each xProcedure In ac.Procedures
Debug.Print "アクションクエリ・パラメータ付選択クエリ: " & xProcedure.Name
Next xProcedure
adoCon.Close
Set adoCon = Nothing
Set ac = Nothing
DAOを使ってレコードの取得・更新
※ACCESS側でテーブルをデザインビューで開いているとエラーになるので、データシートビューで開くように
※ACCESS側でテーブルをデザインビューで開いているとエラーになるので、データシートビューで開くように
Sub Sample1()
'※DAOのRecordsetは、ACCESSのレコードセットと同じように使えると思う
Dim wks As DAO.Workspace
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim path As String
Dim criteriaStr As String
Dim xRow As Long
Dim i As Long
path = "C:\work\テスト.accdb"
Set wks = DBEngine.Workspaces(0)
'ワークスペースの確保。Workspaces(0)とするのが定番らしいが、トラブルが多いようだ
'ワークスペースは、トランザクションを使用するために必要となる
'Set wks = CreateWorkspace("wks", "admin", "", dbUseJet)
'上記のように、新規にワークスペースの宣言をすることも可能
Set db = wks.OpenDatabase(path)
Set rs = db.OpenRecordset("数値", dbOpenDynaset)
'「数値」テーブルのRecodsetをダイナセットで開く。dbOpenDynasetの指定は必要
Cells.Clear
xRow = 1
On Error Resume Next
'取得件数が0だと、.MoveFirst でエラーになってしまうのでエラー無視で
rs.MoveFirst 'レコードの先頭へ
On Error GoTo 0
Do Until rs.EOF
For i = 0 To rs.Fields.Count - 1
If xRow = 1 Then '1行目はフィールド名を出力
Cells(xRow, i + 1) = rs(i).Name
Cells(xRow + 1, i + 1) = rs(i).Value
Else
Cells(xRow, i + 1) = rs(i).Value
End If
Next i
rs.MoveNext
If xRow = 1 Then
xRow = 3
Else
xRow = xRow + 1
End If
Loop
xRow = 30
criteriaStr = "整数 > 40"
With rs
.FindFirst criteriaStr
'検索条件にマッチする最初のレコードへ。Recodsetを開く時にdbOpenDynasetの指定が無いとここでエラーになるらしい
Do Until .NoMatch
Cells(xRow, 1) = !バイト
Cells(xRow, 2) = !整数
Cells(xRow, 3) = !長整数
xRow = xRow + 1
.FindNext criteriaStr
Loop
End With
On Error Resume Next
wks.BeginTrans 'トランザクション開始
criteriaStr = "整数 > 70"
With rs
.FindFirst criteriaStr
Do Until .NoMatch
.Edit
!バイト = !バイト + 1
!整数 = !整数 + 1
!長整数 = !長整数 + 1
.Update '更新
.FindNext criteriaStr
Loop
End With
If Err.number > 0 Then 'エラーが発生している場合
wks.Rollback 'ロールバック
Else
wks.CommitTrans 'コミット
End If
On Error GoTo 0
On Error Resume Next
rs.Close 'すでにCloseしていたり、Openしていない場合はエラーになるので、エラー無視でいいと思う
db.Close
'※必須。データベースをCloseしないと、その後でWorkspaces(0)が使えなくなることがある
wks.Close
Set rs = Nothing
Set db = Nothing
Set wks = Nothing
On Error GoTo 0
End Sub
ADOでフィールドのデータ型を取得する
※添付ファイル型は注意が必要
Sub Sample1()
'テーブル・クエリのフィールドのデータ型を出力
Dim adoCon As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim path As String
Dim tableName As String
Dim i As Long
path = "C:\work\テスト.accdb"
tableName = "全データ型"
'全データ型のフィールドがあるテーブル
' tableName = "Qselect_全データ型"
'「全データ型」テーブルの全フィールドを選択しているクエリ。添付ファイル型のフィールドも含むので、エラーになる
' tableName = "Qselect_全データ型2"
'「全データ型」テーブルの添付ファイル型のフィールドだけ除外したクエリ。これはエラーにならない
Set adoCon = New ADODB.Connection
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
On Error GoTo ErrorHandler
Set adoRs = New ADODB.Recordset
With adoRs
.Source = tableName
.ActiveConnection = adoCon
.Open
'添付ファイル型のフィールドを選択しているクエリの場合、ここでエラーになる。テーブルは大丈夫
End With
On Error GoTo 0
For i = 0 To adoRs.Fields.Count - 1
Debug.Print "フィールド名: " & adoRs.Fields(i).Name & " TYPE: " & adoRs.Fields(i).Type
Next i
ReturnPoint:
On Error Resume Next
adoRs.Close
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "テーブル・クエリのOpenに失敗しました。添付ファイル型のフィールドがあるクエリを指定した可能性があります"
Resume ReturnPoint
End Sub
Sub Sample2()
'フィールド名を指定して、データ型を取得
Dim path As String
Dim tableName As String
Dim fieldName As String
path = "C:\work\テスト.accdb"
tableName = "全データ型"
' tableName = "Qselect_全データ型"
' tableName = "Qselect_全データ型2"
fieldName = "数値_バイト"
' fieldName = "添付ファイル"
' fieldName = "存在しないフィールド"
Debug.Print GetFieldType(path, tableName, fieldName)
End Sub
Function GetFieldType(path As String, tableName As String, fieldName As String) As String
'フィールドのデータ型を取得する。クエリもOK
'添付ファイル型は長いテキストと判定される
Dim adoCon As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim fieldType As Long 'フィールドのデータ型を表す数値
Set adoCon = New ADODB.Connection
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
On Error GoTo ErrorHandler
Set adoRs = New ADODB.Recordset
With adoRs
.Source = tableName
.ActiveConnection = adoCon
.Open
'添付ファイル型のフィールドを選択しているクエリの場合、ここでエラーになる。テーブルは大丈夫
End With
On Error GoTo 0
On Error GoTo ErrorHandler2
fieldType = adoRs.Fields(fieldName).Type
On Error GoTo 0
Select Case fieldType
Case 2
GetFieldType = "数値(整数)"
Case 3
GetFieldType = "数値(長整数)"
Case 4
GetFieldType = "数値(単精度浮動小数点)"
Case 5
GetFieldType = "数値(倍精度浮動小数点)"
Case 6
GetFieldType = "通貨"
Case 7
GetFieldType = "日付/時刻"
Case 11
GetFieldType = "Yes/No"
Case 17
GetFieldType = "数値(バイト)"
Case 20
GetFieldType = "大きい数値"
Case 131
GetFieldType = "数値(十進)"
Case 202
GetFieldType = "短いテキスト"
Case 203
GetFieldType = "長いテキスト(添付ファイル型の可能性有り)"
Case 205
GetFieldType = "OLE"
Case Else
GetFieldType = "その他"
End Select
ReturnPoint:
On Error Resume Next
adoRs.Close
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
Exit Function
ErrorHandler:
MsgBox "テーブル・クエリのOpenに失敗しました。テーブル名・クエリ名が間違っているか、添付ファイル型のフィールドがあるクエリを指定した可能性があります"
Resume ReturnPoint
ErrorHandler2:
MsgBox "フィールドのデータ型の取得に失敗しました。フィールド名が間違っている可能性があります"
Resume ReturnPoint
End Function
ADOでクエリのデータを取得する
※基本的にテーブルと同じだが、添付ファイル型のフィールドを選択しているクエリは、Open時にエラーになってしまうらしい
Sub Sample2()
'クエリのデータをADOで取得する
'基本的にはテーブルと同じだが、添付ファイル型のフィールドを選択しているクエリはOpen時にエラーになるらしい
Dim adoCon As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim path As String
Dim queryName As String
Dim i As Long
path = "C:\work\テスト.accdb"
tableName = "Qselect_全データ型2"
'「Qselect_全データ型2」クエリは、「全データ型」テーブルの添付ファイル型フィールドを選択していない
'tableName = "Qselect_全データ型"
'「Qselect_全データ型」クエリは、「全データ型」テーブルの添付ファイル型フィールドを選択しているのでOpen時にエラーになる
Set adoCon = New ADODB.Connection
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
Set adoRs = New ADODB.Recordset
With adoRs
.Source = tableName
.ActiveConnection = adoCon
.Open
End With
For i = 0 To adoRs.Fields.Count - 1
Debug.Print "フィールド名: " & adoRs.Fields(i).Name & " TYPE: " & adoRs.Fields(i).Type
Next i
adoRs.Close
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
End Sub
SQLのLIKE句に関する注意点
DAOでは LIKE '*a*' で、 ADOでは LIKE '%a%' にする？
ACCESSのSQLや、ACCESSのVBAコード内のSQLなら、LIKE '*a*' で"a"を含む文字列にヒットするが、
ExcelのVBAからACCESSを操作する場合、LIKE '%a%' と LIKE '*a*' を使い分けする必要があるらしい
DAO : LIKE '*a*' とすれば"a"を含む文字列にヒットする
ADO : LIKE '%a%' とすれば"a"を含む文字列にヒットする
"%" そのものを指定したい場合は、[%]としてエスケープで
DAO : LIKE '*[%]*' とすれば"%"を含む文字列にヒットする
ADO : LIKE '%[%]%' とすれば"%"を含む文字列にヒットする
ADOを使用した場合の、SQL文内での特殊文字のエスケープ
DAOは違った結果になるかも ACCESSのSQLや、ACCESSのVBAコード内のSQLと性質が違うようなので注意
ADOを使用した場合の、SQL文内での特殊文字のエスケープ。DAOは違った結果になるかも
ACCESSのSQLや、ACCESSのVBAコード内のSQLと性質が違うようなので注意
[]で囲むとエスケープされるらしい
"SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%[%]%'" %を含む文字列にヒット
"SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%[""]%'" "を含む文字列にヒット。2つ重ねること
"SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%['']%'" 'を含む文字列にヒット。2つ重ねること
"SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%[[]%'" [を含む文字列にヒット
"SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%[]]%'" ]を含む文字列にヒット
' [ ] の3つは、検索は可能だがなるべく除外したほうがいいだろう
ADOでのSQLで、大文字・小文字、半角･全角、ひらがな・カタカナを区別するバイナリモードを利用する
単純にOption Compare Binaryと宣言しても駄目らしい
************** バイナリモードで文字列比較 **********************************
Option Compare Binary 'バイナリモードで文字列比較。この宣言が無くてもデフォルトでこの設定
Option Explicit
Sub aaa()
Debug.Print "AAA" = "aaa" 'False 大文字･小文字を区別するので
Debug.Print "AAA" Like "*a*" 'False
End Sub
************** テキストモードで文字列比較 **********************************
Option Compare Text 'テキストモードで文字列比較
Option Explicit
Sub bbb()
Debug.Print "AAA" = "aaa" 'True 大文字･小文字を区別しないので
Debug.Print "AAA" Like "*a*" 'True
End Sub
************** VBAコード内でのSQL **********************************
Sub Sample1()
'Option Compare Binary宣言をしても、VBAコード内のSQLでは大文字・小文字が区別されないらしい
'InStr関数等を使用すれば、バイナリ比較が可能
Dim adoCon As Object
Dim adoRs As Object
Dim path As String
Dim sqlStr As String
Dim str1 As String
str1 = "a" '検索する文字列
path = "C:\work\テスト.accdb"
Set adoCon = CreateObject("ADODB.Connection")
adoCon.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";"
adoCon.Open
Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
sqlStr = "SELECT * FROM 文字列 WHERE 短いテキスト LIKE '%" & str1 & "%'"
'VBAコード内では、LIKE句は*ではなく%を使う
'これは大文字・小文字、半角・全角、ひらがな・カタカナが区別されない
sqlStr = "SELECT * FROM 文字列 WHERE StrComp([短いテキスト], '" & str1 & "', 0) = 0"
'上のコードだと、バイナリモードで完全一致( = ) の結果が得られる
'大文字・小文字、半角・全角、ひらがな・カタカナが区別される
' sqlStr = "SELECT * FROM 文字列 WHERE InStr(1, [短いテキスト], '" & str1 & "', 0)>0"
'これは部分一致 LIKE '%a%'
' sqlStr = "SELECT * FROM 文字列 WHERE InStr(1, [短いテキスト], '" & str1 & "', 0) = 1"
'これは前方一致 LIKE 'a%'
' sqlStr = "SELECT * FROM 文字列 WHERE StrComp(Right([短いテキスト],Len('" & str1 & "')),'" & str1 & "',0)=0"
'これは後方一致 LIKE '%a'
Cells.Clear
adoRs.Open sqlStr, adoCon
Cells(1, 1).CopyFromRecordset adoRs
On Error Resume Next
adoRs.Close
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
On Error GoTo 0
End Sub