Public Sub DB接続()
'データベース(DB)接続
Dim myWBPath As String
Dim constr As String, pswd As String, pas As String
Dim i As Long
myWBPath = ActiveWorkbook.Path '←Excelファイルがあるパスを取得
pswd = "パスワード" '←Accessファイルををパスワード保護している場合は必要
pas = myWBPath & "\Access連携.accdb" '←Excelファイルが接続先のAccessファイルと同一階層にあると仮定
'----------データベースに接続-------------
constr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & pas & ";" & _
"Jet OLEDB:Database Password=" & pswd & ";"
con.Open ConnectionString:=constr
' ↓テーブル名
rs.Open Source:="会員名簿", ActiveConnection:=con, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic
'--------------------------------------
End Sub
IDをもとにデータが存在するかを確認
続いてTextBox1(IDのBox)にIDを入力してIDが存在するのかを確認します。
Private Sub TextBox1_Change()
If TextBox1.Value = "" Then
Exit Sub
End If
Call DB接続 '接続コード呼び出し
With rs
.MoveFirst
.Find criteria:="ID='" & TextBox1.Value & "'"
If .EOF = True Then 'IDが存在するか確認
MsgBox "IDが見つかりませんでした"
TextBox1.Value = ""
rs.Close 'データベースを閉じる
con.Close 'データベースを閉じる
Exit Sub
End If
'IDが見つかった場合はフォームにデータを表示
TextBox2.Value = .Fields("氏名").Value
TextBox3.Value = .Fields("住所").Value
End With
rs.Close 'データベースを閉じる
con.Close 'データベースを閉じる
End Sub
Accessデータベースのデータを削除するコード
今回の前回と違う部分がここです。今回はデータを削除するコードです。
Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "IDを指定してください"
Exit Sub
End If
Call DB接続 '接続コード呼び出し
With rs
.Find criteria:="ID='" & TextBox1.Value & "'"
If .EOF = True Then 'IDが存在するか確認
MsgBox "IDが見つかりませんでした"
TextBox1.Value = ""
Exit Sub
End If
Dim res As Integer
res = MsgBox("データを削除します、よろしいですか?", vbYesNo)
If res = vbNo Then Exit Sub
'IDが見つかった場合は変更処理
.Delete 'データを削除する
End With
MsgBox "削除しました"
rs.Close 'データベースを閉じる
con.Close 'データベースを閉じる
End Sub
違う部分はここだけですね
Dim res As Integer
res = MsgBox("データを削除します、よろしいですか?", vbYesNo)
If res = vbNo Then Exit Sub
'IDが見つかった場合は変更処理
.Delete 'データを削除する
End With
MsgBox "削除しました"
コメントを残す