TECHNOLOGY

CASE STUDY ON ER DIAGRAM

- by admin

QUESTION

Scenario

 

You are required to implement a database to meet the requirements of the City Crèche  Database system using the Entity Relationship Model attached.  The system should contain the following:

 

•          Tables

•          Forms

•          Queries

•          Reports

•          Relationships

•          Macros

 

Documentation

•          Front page with name, topic etc.

•          Screen Capture from the Relationship Diagram

•          Output from all reports

•          Screen Capture for each form used

•          Evidence of SQL

•          Brief user guide

 A disk containing a working copy of your application should also be provided.

 SOLUTION

 

Scenario

In a creche children are kept for certain hours to look after. Working parents do not have time to care  their wards. The creche has a few rooms. The staffs are dedicated to give duties in specific room. The child-diary is the record of child looked after in specific room. The staff table and meal table are constant tables. The parent and child tables are related in a many to many relation. The invoice table contains diary booking cost and meal booking cost. The diary booking cost may come from the child_diary and meal booking cost may come from the meal table. But as such no provision are made to do that.

ER Diagram

 

Database & Relation creation SQL

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Child]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Child](

[Child_Id] [nvarchar](3) NOT NULL,

[FirstName] [nvarchar](30) NULL,

[SecondName] [nvarchar](30) NULL,

[DateofBirth] [datetime] NULL,

CONSTRAINT [PK_Child] PRIMARY KEY CLUSTERED

(

[Child_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Parent]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Parent](

[Parent_Id] [nvarchar](3) NOT NULL,

[FirstName] [nvarchar](30) NULL,

[SecondName] [nvarchar](30) NULL,

[ContactNo] [nvarchar](30) NULL,

[Address1] [nvarchar](45) NULL,

[Address2] [nvarchar](45) NULL,

[EmergencyNo] [nvarchar](30) NULL,

CONSTRAINT [PK_Parent] PRIMARY KEY CLUSTERED

(

[Parent_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Staff]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Staff](

[Staff_Id] [nvarchar](3) NOT NULL,

[Staff_Name] [nvarchar](30) NULL,

[eMail] [nvarchar](30) NULL,

[TelephoneNo] [nvarchar](25) NULL,

[Qualification] [nvarchar](50) NULL,

CONSTRAINT [PK_Staff] PRIMARY KEY CLUSTERED

(

[Staff_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Room]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Room](

[Room_Id] [nvarchar](3) NOT NULL,

[Room_Name] [nvarchar](30) NULL,

[Room_Activity] [nvarchar](30) NULL,

[Child_Head_Count] [smallint] NULL,

CONSTRAINT [PK_Room] PRIMARY KEY CLUSTERED

(

[Room_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Invoice]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Invoice](

[Invoice_No] [nvarchar](6) NOT NULL,

[Parent_Id] [nvarchar](3) NULL,

[Child_Id] [nvarchar](3) NULL,

[Diary_Booking_Cost] [float] NULL,

[Meal_Booking_Cost] [float] NULL,

[Total_Cost] [float] NULL,

CONSTRAINT [PK_Invoice] PRIMARY KEY CLUSTERED

(

[Invoice_No] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

 

SET ANSI_NULLS ON

GO

 

SET QUOTED_IDENTIFIER ON

GO

 

IF NOT EXISTS (SELECT * FROM sys.triggers WHERE object_id = OBJECT_ID(N'[dbo].[total_cost]’))

EXEC dbo.sp_executesql @statement = N’create trigger [dbo].[total_cost]

on [dbo].[Invoice]

for Insert

as

update invoice set total_cost = Diary_Booking_Cost+Meal_Booking_Cost

where Diary_Booking_Cost+Meal_Booking_Cost>0

 

‘

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Child_Diary]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Child_Diary](

[Child_Id] [nvarchar](3) NOT NULL,

[Room_Id] [nvarchar](3) NOT NULL,

[Date_Time] [datetime] NULL,

CONSTRAINT [PK_Child_Diary] PRIMARY KEY CLUSTERED

(

[Child_Id] ASC,

[Room_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[ChildParent]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[ChildParent](

[Child_Id] [nvarchar](3) NULL,

[Parent_Id] [nvarchar](3) NULL

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[Meal]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[Meal](

[Meal_Id] [char](3) NOT NULL,

[Meal_Type] [nvarchar](30) NULL,

[Meal_Date] [datetime] NULL,

[Child_Id] [nvarchar](3) NULL,

CONSTRAINT [PK_Meal] PRIMARY KEY CLUSTERED

(

[Meal_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

SET ANSI_NULLS ON

GO

SET QUOTED_IDENTIFIER ON

GO

IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[StaffTimeTable]’) AND type in (N’U’))

BEGIN

CREATE TABLE [dbo].[StaffTimeTable](

[Room_Id] [nvarchar](3) NOT NULL,

[Staff_Id] [nvarchar](3) NOT NULL,

[DateTime] [datetime] NULL,

CONSTRAINT [PK_StaffTimeTable] PRIMARY KEY CLUSTERED

(

[Room_Id] ASC,

[Staff_Id] ASC

)WITH (PAD_INDEX  = OFF, IGNORE_DUP_KEY = OFF) ON [PRIMARY]

) ON [PRIMARY]

END

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_Invoice_Child]’) AND parent_object_id = OBJECT_ID(N'[dbo].[Invoice]’))

ALTER TABLE [dbo].[Invoice]  WITH CHECK ADD  CONSTRAINT [FK_Invoice_Child] FOREIGN KEY([Child_Id])

REFERENCES [dbo].[Child] ([Child_Id])

GO

ALTER TABLE [dbo].[Invoice] CHECK CONSTRAINT [FK_Invoice_Child]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_Invoice_Parent]’) AND parent_object_id = OBJECT_ID(N'[dbo].[Invoice]’))

ALTER TABLE [dbo].[Invoice]  WITH CHECK ADD  CONSTRAINT [FK_Invoice_Parent] FOREIGN KEY([Parent_Id])

REFERENCES [dbo].[Parent] ([Parent_Id])

GO

ALTER TABLE [dbo].[Invoice] CHECK CONSTRAINT [FK_Invoice_Parent]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_Child_Diary_Child]’) AND parent_object_id = OBJECT_ID(N'[dbo].[Child_Diary]’))

ALTER TABLE [dbo].[Child_Diary]  WITH CHECK ADD  CONSTRAINT [FK_Child_Diary_Child] FOREIGN KEY([Child_Id])

REFERENCES [dbo].[Child] ([Child_Id])

GO

ALTER TABLE [dbo].[Child_Diary] CHECK CONSTRAINT [FK_Child_Diary_Child]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_Child_Diary_Room]’) AND parent_object_id = OBJECT_ID(N'[dbo].[Child_Diary]’))

ALTER TABLE [dbo].[Child_Diary]  WITH CHECK ADD  CONSTRAINT [FK_Child_Diary_Room] FOREIGN KEY([Room_Id])

REFERENCES [dbo].[Room] ([Room_Id])

GO

ALTER TABLE [dbo].[Child_Diary] CHECK CONSTRAINT [FK_Child_Diary_Room]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_ChildParent_Child]’) AND parent_object_id = OBJECT_ID(N'[dbo].[ChildParent]’))

ALTER TABLE [dbo].[ChildParent]  WITH CHECK ADD  CONSTRAINT [FK_ChildParent_Child] FOREIGN KEY([Child_Id])

REFERENCES [dbo].[Child] ([Child_Id])

GO

ALTER TABLE [dbo].[ChildParent] CHECK CONSTRAINT [FK_ChildParent_Child]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_ChildParent_Parent]’) AND parent_object_id = OBJECT_ID(N'[dbo].[ChildParent]’))

ALTER TABLE [dbo].[ChildParent]  WITH CHECK ADD  CONSTRAINT [FK_ChildParent_Parent] FOREIGN KEY([Parent_Id])

REFERENCES [dbo].[Parent] ([Parent_Id])

GO

ALTER TABLE [dbo].[ChildParent] CHECK CONSTRAINT [FK_ChildParent_Parent]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_Meal_Child]’) AND parent_object_id = OBJECT_ID(N'[dbo].[Meal]’))

ALTER TABLE [dbo].[Meal]  WITH CHECK ADD  CONSTRAINT [FK_Meal_Child] FOREIGN KEY([Child_Id])

REFERENCES [dbo].[Child] ([Child_Id])

GO

ALTER TABLE [dbo].[Meal] CHECK CONSTRAINT [FK_Meal_Child]

GO

IF NOT EXISTS (SELECT * FROM sys.foreign_keys WHERE object_id = OBJECT_ID(N'[dbo].[FK_StaffTimeTable_Room]’) AND parent_object_id = OBJECT_ID(N'[dbo].[StaffTimeTable]’))

ALTER TABLE [dbo].[StaffTimeTable]  WITH CHECK ADD  CONSTRAINT [FK_StaffTimeTable_Room] FOREIGN KEY([Room_Id])

REFERENCES [dbo].[Room] ([Room_Id])

GO

ALTER TABLE [dbo].[StaffTimeTable] CHECK CONSTRAINT [FK_StaffTimeTable_Room]

 

Forms

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Reports

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Code behind Customer

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()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Cus_ID,Cus_Name,Cus_Addr,Cus_AddedOn from Customer Order by Cus_ID”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

 

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Code behind Employee Form

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()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Emp_ID,Emp_name,Emp_DOB,Emp_join_dt from Employee Order by Emp_ID”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

 

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Code Behind Invoice Form

 

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 DataCombo1_Click(Area As Integer)

txtFields(1).Text = DataCombo1.BoundText

End Sub

 

Private Sub Form_Load()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Inv_No,Job_ID from Invoice”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

 

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Private Sub txtFields_Change(Index As Integer)

DataCombo1.BoundText = txtFields(1).Text

End Sub

 

Code Behind Job File Form

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 DataCombo1_Click(Area As Integer)

txtFields(5).Text = DataCombo1.BoundText

End Sub

 

Private Sub DataCombo2_Click(Area As Integer)

txtFields(7).Text = DataCombo2.BoundText

End Sub

 

Private Sub Form_Load()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Job_ID,Job_Desc,Person_Talked,Date_Recvd,Job_RequestedFor,Cus_ID,Job_HourRate,Emp_ID from JobFile”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

 

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Private Sub txtFields_Change(Index As Integer)

DataCombo1.BoundText = txtFields(5).Text

DataCombo2.BoundText = txtFields(7).Text

End Sub

 

Code Behind Jobsheet Form

 

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 DataCombo1_Click(Area As Integer)

txtFields(3).Text = DataCombo1.BoundText

End Sub

 

Private Sub DataCombo2_Click(Area As Integer)

txtFields(2).Text = DataCombo2.BoundText

End Sub

 

Private Sub Form_Load()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Sht_ID,Sht_date,Job_ID,Emp_ID,Time_spent,Equipment_used,Equipment_value,Time_to_arrive,Billable_hrs from Job_Sheet”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Private Sub txtFields_Change(Index As Integer)

DataCombo1.BoundText = txtFields(3).Text

DataCombo2.BoundText = txtFields(2).Text

End Sub

 

Code Behind Payment Form

 

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 DataCombo1_Click(Area As Integer)

txtFields(1).Text = DataCombo1.BoundText

End Sub

 

Private Sub Form_Load()

Dim db As Connection

Set db = New Connection

db.CursorLocation = adUseClient

db.Open “PROVIDER=MSDASQL;dsn=mdb;uid=;pwd=;”

 

Set adoPrimaryRS = New Recordset

adoPrimaryRS.Open “select Pay_ID,Cus_ID,Date,Amount,Chq_No,DraweeBank from Payment”, db, adOpenStatic, adLockOptimistic

 

Dim oText As TextBox

‘Bind the text boxes to the data provider

For Each oText In Me.txtFields

Set oText.DataSource = adoPrimaryRS

Next

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_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

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()

On Error GoTo AddErr

With adoPrimaryRS

If Not (.BOF And .EOF) Then

mvBookMark = .Bookmark

End If

.AddNew

lblStatus.Caption = “Add record”

mbAddNewFlag = True

SetButtons False

End With

 

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()

‘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

 

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              ‘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

 

Private Sub txtFields_Change(Index As Integer)

DataCombo1.BoundText = txtFields(1).Text

End Sub

JF58

“The presented piece of writing is a good example how the academic paper should be written. However, the text can’t be used as a part of your own and submitted to your professor – it will be considered as plagiarism.

But you can order it from our service and receive complete high-quality custom paper.  Our service offers “Technology” essay sample that was written by professional writer. If you like one, you have an opportunity to buy a similar paper. Any of the academic papers will be written from scratch, according to all customers’ specifications, expectations and highest standards.”

order-now-new                       chat-new (1)

Related Posts

The Open MP Parallel Programming-MAH_041216_58507_2_501983

Software Engineering Assignment Report-121230

Software Engineering Assignment Help-121228

About admin

View all posts by admin →