VB code haned up & no responding

[blueskydaynight]

I am using Ms-access 2003 and VB 6 for programming

using code this to call form frmEmployee

Private Sub cmdAdd_Click()
frmEmployee.dwCommand = "ADD"
frmEmployee.Show vbModal, Me
End Sub

But the moment i m clicking on the OK button VB just hang up no reply and went into no responding mode

code under frmEmployee is



Option Explicit

Public sData As String
Public dwCommand As String

Dim mvBookMark As Variant
Dim mbDataChanged As Boolean
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean

Dim WithEvents adoPrimaryRS_0 As Recordset
Dim WithEvents adoPrimaryRS_1 As Recordset

Private Sub Form_Load()
Dim db As Connection
On Error Resume Next

Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
App.Path & "\Payroll.mdb;"

Set adoPrimaryRS_0 = New Recordset
adoPrimaryRS_0.Open "select ([Last Name] & chr(32) & [First Name]) as Name, tblPayroll.* from tblPayroll", _
db, adOpenStatic, adLockOptimistic

Set adoPrimaryRS_1 = New Recordset
adoPrimaryRS_1.Open "select Position from tblPosition", _
db, adOpenStatic, adLockOptimistic

Dim oText As TextBox
Dim oCombo As ComboBox

For Each oText In Me.txtFields
Set oText.DataSource = adoPrimaryRS_0
Next oText

With adoPrimaryRS_1
.MoveLast
.MoveFirst

Do While Not .EOF
cmbFields(1).AddItem ![Position]
.MoveNext
Loop

.MoveFirst
End With

For Each oCombo In Me.cmbFields
Set oCombo.DataSource = adoPrimaryRS_0
Next oCombo

Select Case dwCommand
Case Is = "FIND"
cmdAdd.Visible = False
cmdEdit.Visible = False
cmdDelete.Visible = False
lblLabel(2).Caption = "Find Option"

cmdFind.Move cmdAdd.Left, cmdAdd.Top
cmdRefresh.Move cmdEdit.Left, cmdEdit.Top
GetEmployee sData, IIf(Not IsNumeric(sData), 1, 0)
Case Is = "ADD"
cmdEdit.Visible = False
cmdDelete.Visible = False
cmdFind.Visible = False

cmdRefresh.Move cmdEdit.Left, cmdEdit.Top

cmdAdd_Click
Case Is = "VIEW_OR_EDIT"
cmdAdd.Visible = False
cmdFind.Visible = False
lblLabel(2).Caption = "Employee's File Editing"
lblLabels(10).Visible = True
lblLabels(11).Visible = True
txtFields(6).Visible = True
txtFields(7).Visible = True

cmdRefresh.Move cmdDelete.Left, cmdDelete.Top
cmdDelete.Move cmdEdit.Left, cmdEdit.Top
cmdEdit.Move cmdAdd.Left, cmdAdd.Top
End Select
End Sub

Private Sub adoPrimaryRS_0_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
lblStatus.Caption = "Record: " & CStr(adoPrimaryRS_0.AbsolutePosition)
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 cmdAdd_Click()
On Error GoTo AddErr

With adoPrimaryRS_0
If Not (.BOF And .EOF) Then
mvBookMark = .Bookmark
End If
.AddNew
lblStatus.Caption = "Add record"

mbAddNewFlag = True
SetButtons False
SetLocking False
cmdUpdate.Default = True
cmdCancel.Cancel = True

cmbFields(0).ListIndex = 0
cmbFields(1).ListIndex = 0
cmbFields(2).ListIndex = 0
cmbFields(3).ListIndex = 0
End With
Exit Sub

AddErr:
MsgBox Err.Description
End Sub

Private Sub cmdFirst_Click()
On Error GoTo GoFirstError

adoPrimaryRS_0.MoveFirst
mbDataChanged = False
Exit Sub

GoFirstError:
MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
On Error GoTo GoLastError

adoPrimaryRS_0.MoveLast
mbDataChanged = False
Exit Sub

GoLastError:
MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
On Error GoTo GoNextError

If Not adoPrimaryRS_0.EOF Then adoPrimaryRS_0.MoveNext
If adoPrimaryRS_0.EOF And adoPrimaryRS_0.RecordCount > 0 Then
Beep
adoPrimaryRS_0.MoveLast
End If

mbDataChanged = False
Exit Sub

GoNextError:
MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError

If Not adoPrimaryRS_0.BOF Then adoPrimaryRS_0.MovePrevious
If adoPrimaryRS_0.BOF And adoPrimaryRS_0.RecordCount > 0 Then
Beep
adoPrimaryRS_0.MoveFirst
End If

mbDataChanged = False
Exit Sub

GoPrevError:
MsgBox Err.Description
End Sub

Private Sub cmdEdit_Click()
On Error GoTo EditErr

mbEditFlag = True
SetButtons False
SetLocking False

cmdUpdate.Default = True
cmdCancel.Cancel = True
Exit Sub

EditErr:
MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr

adoPrimaryRS_0.UpdateBatch adAffectAll

If mbAddNewFlag Then
adoPrimaryRS_0.MoveLast
End If

mbEditFlag = False
mbAddNewFlag = False
SetButtons True
SetLocking True
mbDataChanged = False
cmdRefresh_Click

adoPrimaryRS_0.MoveLast
Exit Sub

UpdateErr:
MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
On Error GoTo DeleteErr

If adoPrimaryRS_0.EOF Then Exit Sub
If MsgBox("Are you sure?", vbQuestion Or vbYesNo) = vbYes Then
With adoPrimaryRS_0
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
End If
Exit Sub

DeleteErr:
MsgBox Err.Description
End Sub

Private Sub cmdFind_Click()
frmFind.Show vbModal, Me

If frmFind.sRet <> vbNullString Then
GetEmployee frmFind.sRet, IIf(Not IsNumeric(frmFind.sRet), 1, 0)
End If
End Sub

Private Sub cmdRefresh_Click()
On Error GoTo RefreshErr

adoPrimaryRS_0.Requery
Exit Sub

RefreshErr:
MsgBox Err.Description
End Sub

Private Sub cmdCancel_Click()
On Error Resume Next

SetButtons True
SetLocking True

mbEditFlag = False
mbAddNewFlag = False
adoPrimaryRS_0.CancelUpdate
If mvBookMark > 0 Then
adoPrimaryRS_0.Bookmark = mvBookMark
Else
adoPrimaryRS_0.MoveFirst
End If

cmdAdd.Default = True
cmdClose.Cancel = True
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub txtFields_GotFocus(Index As Integer)
Select Case Index
Case Is = 4
txtFields(Index).Text = (Format(txtFields(Index).Text, "0.00"))
End Select
End Sub

Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
Dim IsError As Boolean

Select Case Index
Case 4, 6, 7
If txtFields(Index).Text <> vbNullString Then
If Not IsNumeric(txtFields(Index).Text) Then
MsgBox "Please enter a number!", _
vbInformation, "Quantity"
IsError = True
ElseIf Val(txtFields(Index).Text) < 0 Then
MsgBox "Invalid input", vbInformation, "Quantity"
IsError = True
End If

If IsError Then
Cancel = True
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(txtFields(Index).Text)
End If
End If
End Select
End Sub

Private Sub cmbFields_KeyPress(Index As Integer, KeyAscii As Integer)
Dim i As Integer
On Error Resume Next

i = Asc(UCase(Chr(KeyAscii)))

If (i >= 65) And (i <= 90) Then _
cmbFields(Index).ListIndex = i - 65
End Sub

Private Sub GetEmployee(ItemKey As String, Optional opt As Integer = 0)
Dim varBookmark As Variant
On Error Resume Next

With adoPrimaryRS_0
varBookmark = .Bookmark
.MoveLast
.MoveFirst

Select Case opt
Case Is = 0
.Find "[Employee Number] = '" & ItemKey & "'"
Case Is = 1
.Find "[Name] = '" & ItemKey & "'"
End Select

If .EOF Then
.Bookmark = varBookmark

MsgBox "Record does not exist!", vbExclamation
Else
End If
End With
End Sub

Private Sub SetButtons(bVal As Boolean)
cmdUpdate.Visible = Not bVal
cmdCancel.Visible = Not bVal
cmdClose.Visible = bVal
cmdRefresh.Visible = bVal
cmdNext.Enabled = bVal
cmdFirst.Enabled = bVal
cmdLast.Enabled = bVal
cmdPrevious.Enabled = bVal

If dwCommand <> "VIEW_OR_EDIT" Then
cmdAdd.Visible = bVal
ElseIf dwCommand <> "ADD" Then
cmdEdit.Visible = bVal
cmdDelete.Visible = bVal
End If
End Sub

Private Sub SetLocking(bVal As Boolean)
Dim oText As TextBox
Dim oCombo As ComboBox

For Each oText In Me.txtFields
oText.Locked = bVal
Next

For Each oCombo In Me.cmbFields
oCombo.Locked = bVal
Next oCombo
End Sub

[Hack]

Moved

[westconn1]

first take out on error resume next in your form load event, then if there is an error it will break, so that you know where there is an error, and to fix it first, it is really bad to use on error resume next, unless you know what error you are going to get and that it doesn't matter

second go back and edit your post and put the code inside vbcode tags, so that it is readable

[danasegarane]

In your code,There is no OK Button Click Event also.

[blueskydaynight]

Now I am getting error "Method 'open' of object' _Recordset Failed on below code

Set adoPrimaryRS_1 = New Recordset
adoPrimaryRS_1.Open "select Position from tblPosition", _
db, adOpenStatic, adLockOptimistic

[BrendanDavis]

First off, you sure you're not showing the form modally with another form already showing in that state? That won't fix your Method error, but it could cause an error regardless.

[blueskydaynight]

yes I am sure no other form is with modal state

[BrendanDavis]

yes I am sure no other form is with modal state

K good, just checking. Sometimes the simplest answer is the right one ;D

[sparbag]

Hello,
To remove confusion dimension and set your variables that handle the recordsets as:

Dim MyRecordset as ADODB.Recordset
set MyRecordset = New ADODB.Recordset

The same should apply to the connection also. Remember that these being objects should not be in an ambiguous state.

Good luck
Steve

[blueskydaynight]

Still problem is persistent