AccessVBA入門①ADO(ActiveX Data Object)

Access

世間一般では、Excelに比べると、Accessはあまり使用されていないようです。ただ、Accessには、Excelでは処理しきれないような大量のデータを扱うことが出来ます。また、何かと自由度が高いExcelでの構築物に比べて、プログラムの仕組みが構造化されており、属人化されづらく、改修もしやすくなります。そこで、今回からはAccessVBAについて紹介して参りたいと思います。

ADO(ActiveX Data Object)とは

ADOは、データベースを操作するための各種オブジェクトのライブラリです。同種のものにDAOというものがありますが、それと違い、ADOは、Access以外のDBを操作できるというメリットがあります。

ADOのオブジェクトは、下記の通りです。

  • Connection
  • Command
  • Recordset
  • Field
  • Parameter
  • Property
  • Error

データベース接続

◉Connectionオブジェクト

プロパティ

  • ConnectionString：接続情報を返す
  • State：接続状態を返す

メソッド

  • Open
  • Close
  • Execute
  • BeginTrans
  • CommitTrans
  • RollbackTrans
Sub DB接続()
  Dim CN As ADODB.Connection
  Set CN = New ADODB.Connection
  CN.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" &_
                      = "Data Source=" & CurrentProject.Path & "¥test.accdb"
  CN.Open
  Select Case CN.State
    Case adStateOpen
      MsgBox "データベースに接続しています"
    Case adStateClosed
      MsgBox "データベースに接続していません"
  End Select
  CN.Close
  Set CN = Nothing
End Sub

レコードの操作

◉Recordsetオブジェクト

プロパティ

  • BOF(Beginning Of File)
  • EOF(End Of File)
  • RecordCount
  • CursorType
  • CursorType_adOpenForwadOnly
  • CursorType_adOpenKeyset　他のユーザーによる追加・削除確認不可。他動的カーソルと同じ
  • CursorType_adOpenDynamic　動的カーソル。他ユーザーの追加等確認可。
  • CursorType_adOpenStatic　動的カーソル。他ユーザーの追加等確認不可。
  • CursorLocation
  • CursorLocation_adUserServer　サーバー側のカーソルを利用
  • CursorLocation_adUserClient　クライアント側のカーソルを利用
  • LockType
  • LockType_adLockReadOnly
  • LockType_adLockPessimistic　レコード単位の排他的ロック
  • LockType_adLockOptimistic　レコード単位の共有的ロック
  • LockType_adLockBatchOptimistic　共有的バッチ更新
  • LockType_adLockUnspecified　ロックタイプ指定しない
  • Bookmark　レコードを識別するためのブックマーク

メソッド

  • Open
  • Close
  • Move/MoveFirst/MoveLast/MoveNext/MovePrevious
  • Find
  • Clone
  • AddNew
  • Update
  • Delete
Sub レコードセット()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = CN.Execute("T名簿")
  Do Until RS.EOF
    Debug.Print RS.Fields(0),RS.Fields(1),RS.Fields(2)
    RS.MoveNext
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing 
End Sub
Sub レコードセット2()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T名簿", CN , adOpenStatic
  RS.MoveLast
  Do Until RS.EOF
    Debug.Print RS.Fields(0),RS.Fields(1),RS.Fields(2)
    RS.MoveNext
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing 
End Sub

◉レコードの更新

Sub レコード更新()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim SQL As String
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  SQL = "SELECT * FROM T名簿 WHERE 社員番号　= 9999;"
  RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
  RS.Update "給与", "10000"
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub
Sub レコード更新2()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T名簿", CN, adOpenKeyset, adLockOptimistic
  Do Until RS.EOF
    RS("指数") = RS("指数") + 1 
    RS.Update
    RS.MoveNext
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードの追加

Sub レコードの追加()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim FieldList As Variant
  Dim ValueList As Variant
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T部門マスタ", CN, adOpenKeyset, adLockOptimistic
  FieldList = Array("部門コード","部門名")
  ValueList = Array("999","その他")
  RS.AddNew FieldList, ValueList
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub
Sub レコードの追加2()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T部門マスタ", CN, adOpenKeyset, adLockOptimistic
  RS.AddNew
  RS("部門コード") = "999"
  RS("部門名") = "その他"
  RS.Update
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードの削除

Sub レコードの削除()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim SQL As String
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  SQL = "SELECT * FROM T名簿 WHERE 社員番号　= 9999;"
  RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
  RS.Delete
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub
Sub レコードの削除2()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T名簿", CN, adOpenKeyset, adLockOptimistic
  Do Until RS.EOF
    RS.Delete
    RS.MoveNext
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードの検索

Sub レコードの検索()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T名簿", CN, adOpenKeyset, adLockOptimistic
  Do
    RS.Find "所属" = "総務部"
    If Not RS.EOF Then
      Debug.Print RS("社員番号"),RS("氏名")
      RS.Move.Next
    Else
      Exit Do
    End If
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードの並べ替え

Sub レコードの並べ替え()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.CursorLocation = adUseClient
  RS.Open "T名簿", CN
  RS.Sort = "所属 ASC, 番号　DESC"
  Do Until RS.EOF
    Debug.Print RS("氏名"),RS("所属"),RS("番号")
    RS.Move.Next
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードの抽出

Sub レコードの抽出()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "T名簿", CN
  RS.Filter = "番号 = 100 Or 番号 = 101"
  Do Until RS.EOF
    Debug.Print RS("番号"),RS("氏名")
    RS.Move.Next
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉レコードセットを利用

Sub レコードセットを利用()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
　RS.CursorLocation = adUseClient
  RS.Open "T名簿", CN
  Set Me.lst1.Recordset = RS
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub
Private Sub btnClick()
  Set Me.lsta1.Recordset = Nothing
  Me.list1.Requery
End Sub

Private Sub btnClick2()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
　CN.CursorLocation = adUseClient
  Set RS = CN.Execute("名簿")
  Set Me.lst1.Recordset = RS
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

トランザクション

Sub トランザクション()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "名簿",CN,adOpenKeyset,adLockOptimistic
  On Error GoTo ErrExit
  CN.BeginTrans
  Do Until RS.EOF
    If RS("名簿") = 100 Then
      RS("番号") = RS("番号") & "2"
    Else
      RS("番号") = RS("番号") + 1
    End If
    RS.Update
    RS.MoveNext
  Loop
  CN.CommitTrans
  MsgBox "トランザクション確定"
  Exit Sub
ErrExit:
  CN.RollbackTrans
  MsgBox "トランザクション取消"
End Sub

外部データベース利用

◉CSV接続

Sub CSV接続()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim MyPath As String
  MyPath = CurrentProject.Path & "¥"
  Set CN = New ADODB.Connection
  CN.Open "Provider=Microsoft.Jet.OLEDB.4.0:" &_
          "Data Source=" & MyPath & ";" &_
          "Extended Properties='Text;HDR=NO'"
  Set RS = CN.Execute("SELECT * FROM CSV.csv")
  Do Until RS.EOF
    Debug.Print RS.Fields(0),RS.Fields(1),RS.Fields(2)
    RS.Move.Next
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

◉EXCEL接続

Sub EXCEL接続()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim MyPath As String
  MyPath = CurrentProject.Path & "¥"
  Set CN = New ADODB.Connection
  CN.Open "Provider=Microsoft.ACE.OLEDB.12.0:" &_
          "Data Source=" & MyPath & "EXCEL.xlsx;" &_
          "Extended Properties='Excel 12.0;HDR=YES'"
  Set RS = CN.Execute("SELECT * FROM [Sheet1$]")
  Do Until RS.EOF
    Debug.Print RS.("番号"),RS.("商品名"),RS.("値段")
    RS.Move.Next
  Loop
  RS.Close: CN.Close
  Set RS = Nothing: Set CN = Nothing
End Sub

例外処理

Sub 例外処理()
  Dim CN As ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim MyError As ADODB.Error
  Set CN = CurrentProject.Connection
  Set RS = New ADODB.Recordset
  RS.Open "名簿",CN,adOpenKeyset,adLockOptimistic
  On Error GoTo ErrExit
  RS.AddNew
  RS("番号") = "100"
  RS("商品") = "A"
  RS("金額") = "1000"
  RS.Update
  Exit Sub
ErrExit:
  For Each MyErr In CN.Errors
    MsgBox "発生エラーは次の通り" & vbCrLf &_
           MyError.Number & vbCrLf &_
           MyError.Source & vbCrLf &_
           MyError.Description
  Next
End Sub

以上、本日は、ADOについてポイントと代表的なコードをまとめました。最後までお読み頂き、ありがとうございました。

コメント

タイトルとURLをコピーしました