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

About

You may also like...

Your email will not be published. Name and Email fields are required