'เริ่มต้นประกาศตัวแปล
Dim cn As ADODB.Connection
Dim rsType As ADODB.Recordset
Dim cnString As String
Dim cmdSQL As String
Dim StatusDel As Boolean
Dim StatusEdit As Boolean
Dim StatusAdd As Boolean
'ฟอร์มถูกโหลดเพื่อเปิดใช้งานฐานข้อมูล
Private Sub Form_Load()
On Error GoTo Error1
c1 = "Provider=Microsoft.JET.OLEDB.4.0;Data Source=C:\\dbone.mdb"
cnString = c1
Set cn = New ADODB.Connection
Set rsType = New ADODB.Recordset
With cn
.CursorLocation = adUseClient
.ConnectionTimeout = 4
.ConnectionString = cnString
.Open
End With
If cn.State = adStateOpen Then
MsgBox "Connect OK", vbInformation, "Connect"
End If
'Set rsType = cn.Execute(cmdSQL)
cmdSQL = "select * from type"
rsType.Open cmdSQL, cn, adOpenKeyset, adLockBatchOptimistic
txtTypeId.Text = rsType.Fields("type_id")
txtTypeName.Text = rsType.Fields("type_name")
TextStatusTrue
StatusEdit = False
StatusAdd = False
Exit Sub
Error1:
MsgBox "Connect Fail", vbInformation, "Connect"
End Sub
'คำสั่งในปุ่มเพิ่ม
Private Sub Svae_Click()
If StatusAdd = True Then
rsType.AddNew
End If
rsType.Fields("type_id").Value = Val(txtTypeId)
rsType.Fields("type_name").Value = Val(txtTypeName)
rsType.UpdateBatch adAffectCurrent
cn.CommitTrans
TextStatusFalse
rsType.Close
cmdSQL = "select * from type"
rsType.Open cmdSQL, cn, adOpenStatic, adLockReadOnly
txtTypeId.Text = rsType.Fields("type_id")
txtTypeName.Text = rsType.Fields("type_name")
End Sub
'คำสั่งในปุ่มลบ
Private Sub Delete_Click()
On Error GoTo err1
StatusDel = True
rsType.Close
cmdSQL = "select * from type where type_id=" & Val(txtTypeId) & "for update nowait"
cn.BeginTrans
rsType.Open cmdSQL, cn, adOpenDynamic, adLockOptimistic
rsType.Delete adAffectCurrent
err1:
If Err.Number = -2147217873 Then
MsgBox "Child record found"
rsType.CancelUpdate
End If
If Err.Number = -2147467259 Then
MsgBox "Data Locked"
cn.RollbackTrans
cmdSQL = "select * from type"
rsType.Open cmdSQL, cn, adOpenDynamic, adLockOptimistic
rsType.Requery
End If
End Sub
Dim strConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath("database/mydatabase.mdb")&";Jet OLEDB:Database Password=;"
'*** Query ***'
Dim Conn As ADODB.Connection
Set Conn = New ADODB.Connection
Set objRec = New ADODB.Recordset
strSQL = "SELECT * FROM.... "
Conn.ConnectionString = strConnectionString
Conn.Open
objRec.Open strSQL, Conn, 1, 3
'*** Execute ***'
Dim Conn As ADODB.Connection
Set Conn = New ADODB.Connection
Conn.ConnectionString = strConnectionString
Conn.Open
strSQL = "INSERT INTO...."
Conn.Execute (strSQL)
If Err.Number <> 0 Then
Exit Function
End If
Conn.Close
มันก็ลบไม่ได้อยู่ดีครับ ผมเปลี่ยน คำสั่ง SQL เป็น Delete From Type Where Type_Id = ...
ตามโค้ดครับเอามาให้ดูด้วยว่าแบบนี้ถูกมั้ยหรือว่าคำสั่งอื่นผิดครับ ผมจับจุดไม่ถูกเลย
Private Sub Delete_Click()
On Error GoTo err1
StatusDel = True
rsType.Close
cmdSQL = "delete from type where type_id=" & Val(txtTypeId)
cn.BeginTrans
rsType.Open cmdSQL, cn, adOpenDynamic, adLockOptimistic
rsType.Delete adAffectCurrent
Exit Sub
err1:
If Err.Number = -2147217873 Then
MsgBox "Child record found"
rsType.CancelUpdate
End If
If Err.Number = -2147467259 Then
MsgBox "Data Locked"
cn.RollbackTrans
cmdSQL = "select * from type"
rsType.Open cmdSQL, cn, adOpenDynamic, adLockOptimistic
rsType.Requery
End If
End Sub
Load balance : Server 02
