AccessVBA 標準モジュール③テーブルデータ操作

Option Compare Database

‘/＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
‘/＊
‘/＊　　　　　　テーブルデータ操作
‘/＊
‘/＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

‘////////////////////////////////////////////テーブルのレコード追加
Sub AddNewRec(TableName)

‘データベース定義
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
‘レコードセットを開く
rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

‘新規レコードに移動
DoCmd.GoToRecord acActiveDataObject, , acNewRec

End Sub

‘////////////////////////////////////////////テーブルの全データ消去
Sub TableClear(TableName)

On Error GoTo Err_TableClear
‘データベース、警告文の定義
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim Strmsg As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset

rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
Strmsg = rs.RecordCount & “件のレコードを削除します。”

‘テーブルのデータ全消去
If MsgBox(Strmsg, vbCritical + vbOKCancel) = vbOK Then
If rs.RecordCount > 0 Then
Do Until rs.EOF
rs.Delete
rs.MoveNext
Loop
MsgBox comMsg0002
End If
Else
MsgBox comMsg0013
End If
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

Exit_TableClear:
Exit Sub
Err_TableClear:
MsgBox Err.Description
Resume Exit_TableClear
End Sub
‘////////////////////////////////////////////テーブルの特定データ消去（The Specific Data Erasure by the Table)
Sub SDET(TableName, Field, No)

On Error GoTo Err_SDET
‘データベース、警告文の定義
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset

rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

‘消去
If MsgBox(comMsg0005, vbCritical + vbOKCancel) = vbOK Then
If tbl.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
Do
rs.Find “” & [Field] & ” ='” & No & “‘”
If Not rs.EOF Then
rs.Delete
rs.MoveNext
Else
Exit Do
End If
Loop
MsgBox comMsg0002
End If
Else
MsgBox comMsg0013
End If
rs.Close: Set rs = Nothing
cn.Close: Set sn = Nothing

Exit_SDET:
Exit Sub
Err_SDET:
MsgBox Err.Description
Resume Exit_SDET
End Sub

Sub TbCreate(TableName, FieldsSet)
‘///////////////////////新規テーブル作成（空のテーブル）///////////////////////////////////////
‘//
‘//　　引数として、以下受け取る
‘//　　　　・「テーブル名」
‘//　　　　・「フィールド名1　データ型1,フィールド名2　データ型2,フィールド名3　データ型3,」
‘// 作成場所は、カレントデータベースとする
‘//
‘/////////////////////////////////////////////////////////////////////////////////////////////
‘
‘ On Error GoTo エラー
‘
‘ Dim db As DAO.Database
‘ Dim strSQL As String
‘ Set db = CurrentDb
‘
‘ strSQL = “CREATE TABLE ” & TableName & ” (” & FieldsSet & “);”
‘ Debug.Print strSQL
‘ db.Execute strSQL
‘
‘ db.Close: Set db = Nothing
‘
‘ Exit Sub
‘
‘エラー:
‘ MsgBox Err.Number & ” : ” & Err.Description
End Sub