呵呵,怎么全贴出来了。我见过这样的现象。不知是不是和你的一样
正常的代码两个机子上一个能打开,一个不能打开,当时我们两个机子的
VB版本不一样,ADO的版本也不一样,出现这样的情况,把ADO取消了,再
引用一次,编译一次,就能解决。另外为什么不声明成
Dim WithEvents adoPrimaryRS As ADODB.Recordset呢?
真的是很怪,我将程序放到另一台电脑中可以正常运行。
我将两台的部件和引用打印出来以后对照了一下完全一致。
楼上兄弟所说的dao我也试过了。现将代码贴出来:Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean
Private Sub Command1_Click()
Dim cmd As New ADODB.Command
Dim i As Integer
i = MsgBox("结束初始化开票收款数据以后,就不准在修改初始数据了?", 33, "程序提示")
If i = 1 Then
cmd.ActiveConnection = cn
cmd.Prepared = True
cmd.CommandTimeout = 300
cmd.CommandText = "insert into 销售开票收款结余 select * from 销售开票收款期初"
cmd.CommandType = adCmdText
On Error Resume Next
cmd.Execute
Set cmd = Nothing
End If
End Sub
Private Sub Form_Load()
cn.CursorLocation = adUseClient
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select 会计年度,会计期间,客户内码,客户代码,客户名称,开票结余,收款结余 from 销售开票收款期初", cn, adOpenKeyset, adLockOptimistic
Set grdDataGrid.DataSource = adoPrimaryRS
mbDataChanged = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
'当窗体调整时会调整网格
grdDataGrid.Height = Me.ScaleHeight - 30 - picButtons.Height - picStatBox.Height
lblStatus.Width = Me.Width - 1500
cmdNext.Left = lblStatus.Width + 700
cmdLast.Left = cmdNext.Left + 340
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If mbEditFlag Or mbAddNewFlag Then Exit Sub
Select Case KeyCode
Case vbKeyEscape
cmdClose_Click
Case vbKeyEnd
cmdLast_Click
Case vbKeyHome
cmdFirst_Click
Case vbKeyUp, vbKeyPageUp
If Shift = vbCtrlMask Then
cmdFirst_Click
Else
cmdPrevious_Click
End If
Case vbKeyDown, vbKeyPageDown
If Shift = vbCtrlMask Then
cmdLast_Click
Else
cmdNext_Click
End If
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
Unload findfrm
End Sub
Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'为这个 recordset 显示当前记录位置
lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
adoPrimaryRS.MoveLast
adoPrimaryRS.AddNew
grdDataGrid.SetFocus
Exit Sub
AddErr:
MsgBox err.Description
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DeleteErr
With adoPrimaryRS
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
Exit Sub
DeleteErr:
MsgBox err.Description
End Sub
Private Sub cmdrefresh_Click()
'只有多用户应用程序需要
On Error GoTo RefreshErr
Set grdDataGrid.DataSource = Nothing
adoPrimaryRS.Requery
Set grdDataGrid.DataSource = adoPrimaryRS
Exit Sub
RefreshErr:
MsgBox err.Description
End Sub
Private Sub cmdEdit_Click()
On Error GoTo EditErr
lblStatus.Caption = "编辑记录"
mbEditFlag = True
SetButtons False
Exit Sub
EditErr:
MsgBox err.Description
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
SetButtons True
mbEditFlag = False
mbAddNewFlag = False
adoPrimaryRS.CancelUpdate
If mvBookMark > 0 Then
adoPrimaryRS.Bookmark = mvBookMark
Else
adoPrimaryRS.MoveFirst
End If
mbDataChanged = False
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
adoPrimaryRS.UpdateBatch adAffectAll
If mbAddNewFlag Then
adoPrimaryRS.MoveLast '移到新记录
End If
Exit Sub
UpdateErr:
MsgBox err.Description
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdFirst_Click()
On Error GoTo GoFirstError
adoPrimaryRS.MoveFirst
mbDataChanged = False
Exit Sub
GoFirstError:
MsgBox err.Description
End Sub
Private Sub cmdLast_Click()
On Error GoTo GoLastError
adoPrimaryRS.MoveLast
mbDataChanged = False
Exit Sub
GoLastError:
MsgBox err.Description
End Sub
Private Sub cmdNext_Click()
On Error GoTo GoNextError
If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
If adoPrimaryRS.EOF And adoPrimaryRS.recordcount > 0 Then
Beep
'已到最后返回
adoPrimaryRS.MoveLast
End If
'显示当前记录
mbDataChanged = False
Exit Sub
GoNextError:
MsgBox err.Description
End Sub
Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError
If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
If adoPrimaryRS.BOF And adoPrimaryRS.recordcount > 0 Then
Beep
'已到最后返回
adoPrimaryRS.MoveFirst
End If
'显示当前记录
mbDataChanged = False
Exit Sub
GoPrevError:
MsgBox err.Description
End Sub
Private Sub SetButtons(bVal As Boolean)
cmdAdd.Visible = bVal
cmdEdit.Visible = bVal
cmdUpdate.Visible = Not bVal
cmdCancel.Visible = Not bVal
cmdDelete.Visible = bVal
cmdClose.Visible = bVal
cmdRefresh.Visible = bVal
cmdNext.Enabled = bVal
cmdFirst.Enabled = bVal
cmdLast.Enabled = bVal
cmdPrevious.Enabled = bVal
End Sub