請問諸前輩,以下是小弟一段程式,為何第一次新增一筆資料後
requery在recordset內沒有新增的資料,可是再新增一筆後
requery在recordset內兩筆新增資料均出現
vb新手 c.m.
frmDepartment.frm
Option Explicit
Dim conDepartment As ADODB.Connection
Dim cmdDepartment As ADODB.Command
Dim rsdepartment As ADODB.Recordset
Dim BK As Variant
Dim WithEvents clsdepartment As department
Public stype As Integer '1 新增 2 修改 0 初始
Private Sub Form_Load()
Dim mstring As String
Dim t As Integer
Set clsdepartment = New department
Set conDepartment = New ADODB.Connection
Set cmdDepartment = New ADODB.Command
Set rsdepartment = New ADODB.Recordset
mstring = "Provider=Microsoft.jet.OLEDB.4.0;" & _
"Data Source = f:\vb\cmhung\budgetsys1.mdb;" & _
"Persist Security Info = False"
conDepartment.Open mstring
Set cmdDepartment.ActiveConnection = conDepartment
cmdDepartment.CommandText = "select * from tbDepartment"
rsdepartment.CursorLocation = adUseClient
rsdepartment.Open cmdDepartment, , adOpenDynamic, adLockPessimistic
For t = 0 To 3
Set Text1(t).DataSource = rsdepartment
Text1(t).Locked = True
Next t
Text1(0).DataField = "fldDepartmentNo"
Text1(1).DataField = "fldDepartmentName"
Text1(2).DataField = "fldDepartmentBelong"
Text1(3).DataField = "fldDepartmentType"
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo er
RichTextBox1.Visible = False
Select Case Button.Key
Case "new"
Call tool_new
Case "edit"
Call tool_edit
Case "save"
Call tool_save
End Select
Exit Sub
er:
Beep
If MsgBox(Err.Description, vbRetryCancel + vbExclamation, "錯誤訊息") = vbRetry Then
Resume 0
Else
End
End If
End Sub
Private Sub tool_new()
Dim t As Integer
stype = 1
For t = 0 To 3
Text1(t).DataField = ""
Text1(t).Text = ""
Text1(t).Locked = False
Next t
Text1(0).SetFocus
BK = rsdepartment.Bookmark
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = False
StatusBar1.Panels(1).Text = "新增"
End Sub
Private Sub tool_save()
Dim sfind As String
Dim t As Integer
If stype = 1 Then
sfind = CheckForQuote(Text1(0).Text)
rsdepartment.MoveFirst
rsdepartment.Find ("fldDepartmentNo ='" & RTrim(sfind) & "'")
If rsdepartment.EOF Then
clsdepartment.departmentno = Text1(0)
clsdepartment.departmentname = Text1(1)
clsdepartment.departmentbelong = Text1(2)
clsdepartment.departmenttype = Text1(3)
clsdepartment.add
??為何第一次requery不發生作用?第二次後就沒問題????
rsdepartment.Requery
Toolbar1.Buttons(6).ToolTipText = "關閉"
StatusBar1.Panels(1).Text = "狀態"
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = True
For t = 0 To 3
Text1(t).Locked = True
Next t
Text1(0).DataField = "fldDepartmentNo"
Text1(1).DataField = "fldDepartmentName"
Text1(2).DataField = "fldDepartmentBelong"
Text1(3).DataField = "fldDepartmentType"
stype = 0
Else
MsgBox sfind + "資料重複", vbOKOnly, "錯誤訊息"
End If
End If
If stype = 2 Then
clsdepartment.departmentno = Text1(0)
clsdepartment.departmentname = Text1(1)
clsdepartment.departmentbelong = Text1(2)
clsdepartment.departmenttype = Text1(3)
clsdepartment.update
rsdepartment.Requery
'rsDepartment.Bookmark = BK
Toolbar1.Buttons(6).ToolTipText = "關閉"
StatusBar1.Panels(1).Text = "狀態"
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = True
For t = 0 To 3
Text1(t).Locked = True
Next t
Text1(0).DataField = "fldDepartmentNo"
Text1(1).DataField = "fldDepartmentName"
Text1(2).DataField = "fldDepartmentBelong"
Text1(3).DataField = "fldDepartmentType"
stype = 0
End If
End Sub
--------------------------
department.cls
Public Sub add()
On Error Resume Next
Dim ssql As String
Dim strcnn As String
Dim cnn1 As ADODB.Connection
Dim cmdChange As ADODB.Command
Dim errLoop As ADODB.Error
strcnn = "Provider=Microsoft.jet.OLEDB.4.0;" & _
"Data Source = f:\vb\cmhung\budgetsys1.mdb;" & _
"Persist Security Info = False"
Set cnn1 = New ADODB.Connection
cnn1.Open strcnn
cnn1.errors.Clear
ssql = "Insert Into tbDepartment (fldDepartmentNo,fldDepartmentName,fldDepartmentBelong,fldDepartmentType)" _
& "values ('" & CheckForQuote(departmentno) & "','" & CheckForQuote(departmentname) & "','" & CheckForQuote(departmentbelong) & "','" & CheckForQuote(departmenttype) & "')"
cnn1.Execute ssql
If cnn1.errors.Count ＞ 0 Then
RaiseEvent errors(cnn1.errors)
Else
RaiseEvent action(300)
End If
cnn1.Close
Set cnn1 = Nothing
End Sub
ps:作業係統windows2000,vb6.0,pc單機