One to Many Data Entry Form VB6

Having problems with Master / Detail entry form

Page 1 of 1

0 Replies - 3363 Views - Last Post: 21 January 2009 - 03:04 PM Rate Topic: -----

#1 hallsway  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 6
  • Joined: 28-August 08

One to Many Data Entry Form VB6

Posted 21 January 2009 - 03:04 PM

Attached File  Project1.zip (19.72K)
Number of downloads: 265I am trying to complete a database project that needs a data input form with an employeeid and name as the master form and a grid to contain ticket numbers, start & stop times, status. I have created a database with two tables techs and tickets. And they are related by employee id. I have a good working form that will display the information, but I am having problems greating a form that will allow me to input the information to where it places the tickets under the correct employe id. I used the Datawizard to create a master / detail form, then modified it to use a datacombo box which I would like to hold the Names from the techs table. It displays the information correctly, but when I attempt to add data, I run into a problem, the input boxes clear as soon a I move to the next field. The delete function appears to be working fine. Any help or suggestions would be greatly appreaciated. Links to examples of Master / Detail or one to many forms would be helpful.
This is the code I have in the form load event. I have added the project and access database as an attachment.



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 Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bucket.mdb;Persist Security Info=False"

Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "SHAPE {select ADID,Name from Techs} AS ParentCMD APPEND ({select TicketNumber,Stop,Start,Status,ADID from Tickets } AS ChildCMD RELATE ADID TO ADID) AS ChildCMD", db, adOpenStatic, adLockOptimistic

Set DataCombo1.DataSource = adoPrimaryRS
Set DataCombo1.RowSource = adoPrimaryRS
Set DataCombo1.DataSource = adoPrimaryRS

Dim oText As TextBox
'Bind the text boxes to the data provider
For Each oText In Me.txtfields
Set oText.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
Next

Set DataGrid1.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
Set DTPickerStart.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
Set DTPickerStop.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
Set cboStatus.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue


mbDataChanged = False
End Sub

Private Sub Form_Resize()
On Error Resume Next
lblStatus.Width = Me.Width - 1500
cmdNext.Left = lblStatus.Width + 700
cmdLast.Left = cmdNext.Left + 340
End Sub

Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
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)
'This will display the current record position for this recordset
lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This is where you put validation code
'This event gets called when the following actions occur
Dim bCancel As Boolean

Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select

If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdAdd_Click()
mbDataChanged = True
txtfields(0).SetFocus


On Error GoTo AddErr
With adoPrimaryRS("ChildCMD").UnderlyingValue
If Not (.BOF And .EOF) Then
mvBookMark = .Bookmark
End If
With adoPrimaryRS
.AddNew
lblStatus.Caption = "Add Ticket"
mbAddNewFlag = True
SetButtons False
End With
End With

Exit Sub
AddErr:
MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
Dim answer
On Error GoTo DeleteErr
answer = MsgBox("Do you want to delete this Ticket?", vbYesNo + vbQuestion, "Delete Ticket")
If answer = vbYes Then
With adoPrimaryRS("ChildCMD").UnderlyingValue
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
End If
Exit Sub
DeleteErr:
MsgBox Err.Description


End Sub

Private Sub cmdRefresh_Click()
'This is only needed for multi user apps
On Error GoTo RefreshErr
adoPrimaryRS.Requery
Exit Sub
RefreshErr:
MsgBox Err.Description
End Sub

Private Sub cmdEdit_Click()
On Error GoTo EditErr

lblStatus.Caption = "Edit record"
mbEditFlag = True
SetButtons False
Exit Sub

EditErr:
MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
DataGrid1.DataChanged = False

SetButtons True
mbEditFlag = False
mbAddNewFlag = False
adoPrimaryRS.CancelUpdate

If mvBookMark > 0 Then

adoPrimaryRS.Bookmark = mvBookMark

Else
'DataGrid1.Index = 1
adoPrimaryRS.MoveFirst
DataGrid1.Enabled = True

End If
mbDataChanged = False

End Sub

Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr

adoPrimaryRS.UpdateBatch adAffectAll

If mbAddNewFlag Then
adoPrimaryRS.MoveLast 'move to the new record

End If


mbEditFlag = False
mbAddNewFlag = False
SetButtons True
mbDataChanged = False

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
'moved off the end so go back
adoPrimaryRS.MoveLast
End If
'show the current record
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
'moved off the end so go back
adoPrimaryRS.MoveFirst
End If
'show the current record
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 


Is This A Good Question/Topic? 0
  • +

Page 1 of 1