Using Classes, Unbound Controls, Etc.

Typically in VB6 i would make a class, i.e. a customers class, and use the class to  populate a datagrid.  Can I use the same approach in access with listboxes, datasheets, and continuos forms?

- I recall having problems with using the value lists of listboxes.

- Can you give me some examples of how to use classes to populate controls/foms.

thanks
tricks801Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Arthur_WoodCommented:
yes, every application I build (and I am a professional Software engineer) is built is precisly that manner, whether in VB 6, VB.NET Access or Excel.  All 4 development environments allow the use of classes and objects to manage the flow of data to and from the user interface.  Such an approach makes the Access and Excel applications that I work on very easy to maintain and extend.

AW
Arthur_WoodCommented:
I will post some sample code shortly.  I have such a application of my other PC (I am using my wife's laptop at the moment).

AW
puppydogbuddyCommented:
See the following link:
             
                        http://www.vb123.com/toolshed/02_docs/classyforms.htm
Arthur_WoodCommented:
here is an example of how I code my Access applications:

this is the code for a fomr with several UNBOUND TextBoxes for entering, displaying and modifying data:

Option Compare Database
Option Explicit

Dim mDone As Boolean
Dim mPOCID As Long
Dim mDIVID As Long
Dim mobjPOC As cPOC
Dim mobjPOCs As cPOCs
Dim mflgLoading As Boolean

Public Property Get Done() As Boolean
    Done = mDone
End Property

Public Property Let POC(NewPOC As Long)
    Set mobjPOC = mobjPOCs.Item(CStr(NewPOC))
    cboPOC = NewPOC
    LoadPOC
End Property

Public Property Let Office(NewOffice As Long)
    mDIVID = NewOffice
    Set mobjPOCs = New cPOCs
    mobjPOCs.Load NewOffice
    mobjPOCs.BeginEdit
End Property
 
Public Sub NewPOC(Office As Long)
    mDIVID = Office
    Set mobjPOCs = New cPOCs
    mobjPOCs.Load Office '
    mobjPOCs.BeginEdit
    Set mobjPOC = mobjPOCs.NewPOC(Office)
   
End Sub

Private Sub cboPOC_NotInList(NewData As String, Response As Integer)
    Dim objPOC As cPOC
    On Error GoTo ErrorLog
    Set objPOC = New cPOC
   
    With objPOC
        .BeginEdit
        .LastName = cboPOC.Text
        .DivID = mDIVID
        .ApplyEdit
    End With
   
   
    Response = acDataErrAdded
    Exit Sub
ErrorLog:
    LogError "frmPOCs", "cboPOC_NotInList", Err.Number, Err.Description
    Resume Next


End Sub

Private Sub chkPrimary_Click()
    mobjPOCs.ClearPrimary
    mobjPOC.Primary = True
End Sub

Private Sub cmdCancel_Click()
    mDone = True
End Sub

Private Sub cmdSave_Click()
    On Error GoTo ErrorLog
    mDone = True
    If mobjPOC.IsNew Then
        mobjPOCs.AddPOC mobjPOC
    End If
    mobjPOCs.ApplyEdit
    Exit Sub
ErrorLog:
    LogError "frmPOC", "cmdSave_Click", Err.Number, Err.Description
    Resume Next

End Sub

Private Sub LoadPOC()
    On Error GoTo ErrorLog
    mflgLoading = True
    With mobjPOC
        txtFirstName = .FirstName & ""
        txtLastName = .LastName & ""
        If UCase(Left$(.Phone, 3)) <> "DSN" Then
            txtPhone = Format$(.Phone, "(###) ###-####")
        Else
            txtPhone = "DSN" & Format$(Right$(.Phone, Len(.Phone) - 3), "###-####")
        End If
        txtPentagon = .PentagonOffice & ""
        txtOther = .OtherLocation & ""
        chkPrimary = .Primary
       
    End With
    LockControls
   
    mflgLoading = False
    Screen.MousePointer = 0 ' normal
    Exit Sub
ErrorLog:
    LogError "frmPOCs", "LoadPOC", Err.Number, Err.Description
    Resume Next


End Sub

Private Sub cboPOC_Click()
    Dim objPOC As cPOC
   
    On Error GoTo ErrorLog
   
    Set mobjPOCs = New cPOCs
    mobjPOCs.Load mDIVID
    mobjPOCs.BeginEdit
   
    On Error Resume Next
    Set mobjPOC = mobjPOCs.Item(CStr(cboPOC))
   
    If Err.Number <> 0 Then
        Set objPOC = New cPOC
        objPOC.Load cboPOC, cboPOC.Column(1, cboPOC.ListIndex)
        objPOC.BeginEdit
        objPOC.DivID = mDIVID
        mobjPOCs.AddPOC objPOC
        mobjPOCs.ApplyEdit
        mobjPOCs.BeginEdit
        Set mobjPOC = mobjPOCs.Item(CStr(cboPOC))
    End If
   
    LoadPOC
    Exit Sub
ErrorLog:
    LogError "frmPOCs", "cboPOC_Click", Err.Number, Err.Description
    Resume Next


End Sub

Private Sub Form_Load()
    mActive = True
    cmdSave.Visible = mActive
End Sub

Private Sub txtFirstName_LostFocus()
    If Not mflgLoading Then _
        mobjPOC.FirstName = txtFirstName & ""
End Sub

Private Sub txtLastName_LostFocus()
    If Not mflgLoading Then _
        mobjPOC.LastName = txtLastName & ""
End Sub

Private Sub txtOther_LostFocus()
    If Not mflgLoading Then _
        mobjPOC.OtherLocation = txtOther & ""
End Sub

Private Sub txtPentagon_LostFocus()
    If Not mflgLoading Then _
        mobjPOC.PentagonOffice = txtPentagon & ""
End Sub

Private Sub txtPhone_LostFocus()
    If Not mflgLoading Then _
        mobjPOC.Phone = txtPhone & ""
End Sub

Private Sub LockControls()
    txtFirstName.Locked = Not mActive
    txtLastName.Locked = Not mActive
    txtPhone.Locked = Not mActive
    txtPentagon.Locked = Not mActive
    txtOther.Locked = Not mActive
    chkPrimary.Locked = Not mActive
   
    If Not mActive Then
       
        cmdCancel.Caption = "Done"
    End If
End Sub


This makes use of the following claases, to hold a cPOCs  which is a class , as a wrapper, around a collection of cPOC (Point of Contact) objects:

cPOCS:

Option Compare Database
Option Explicit

Private mcolPOCs As Collection
Private mflgEditing As Boolean

Private Sub Class_Initialize()
    Set mcolPOCs = New Collection
End Sub

Public Sub Load(Office As Long)
    Dim db As Database
    Dim strSQL As String
    Dim rsPOCs As Recordset
    Dim objDisplay As cPOC
   
    Set db = CurrentDb
    strSQL = "Select POCID, DIVID from tblDIVPOC where DivID = " & Office
   
    Set rsPOCs = db.OpenRecordset(strSQL)
   
    With rsPOCs
        Do While Not .EOF
            Set objDisplay = New cPOC
            objDisplay.Load .Fields("POCID"), Office
            mcolPOCs.Add objDisplay, CStr(objDisplay.PocID)
            Set objDisplay = Nothing
            .MoveNext
        Loop
        .Close
    End With
   
    Set rsPOCs = Nothing
    db.Close
    Set db = Nothing
   
           
End Sub
 
Public Function Count() As Integer
    Count = mcolPOCs.Count
   
End Function

Public Function Item(ByVal Index As Variant) As cPOC
    Set Item = mcolPOCs.Item(Index)
End Function
Public Sub Remove(Index As Variant)
    Dim objPOC As cPOC
    Set objPOC = mcolPOCs.Item(Index)
    objPOC.Delete

End Sub
Public Function NewPOC(Office As Long) As cPOC
    Dim objPOC As cPOC
    Set objPOC = New cPOC
    objPOC.BeginEdit
    objPOC.DivID = Office
    Set NewPOC = objPOC
    Set objPOC = Nothing
   
End Function

Public Sub ClearPrimary()
    Dim objPOC As cPOC
    Dim iPOC As Integer
   
    If Not mflgEditing Then Err.Raise 445
   
    For iPOC = 1 To mcolPOCs.Count
        Set objPOC = mcolPOCs.Item(iPOC)
        objPOC.Primary = False
    Next
End Sub

Public Sub AddPOC(NewPOC As cPOC)
    mcolPOCs.Add NewPOC, CStr(NewPOC.PocID)
End Sub

Public Sub BeginEdit()
    Dim iLine As Integer
    Dim objPOC As cPOC
   
    If mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolPOCs.Count
        Set objPOC = mcolPOCs.Item(iLine)
        objPOC.BeginEdit
    Next
   
    mflgEditing = True
End Sub

Public Sub ApplyEdit()
    Dim iLine As Integer
    Dim objPOC As cPOC
   
    If Not mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolPOCs.Count
        Set objPOC = mcolPOCs.Item(iLine)
        objPOC.ApplyEdit
    Next
    mflgEditing = False
End Sub

Public Sub CancelEdit()
    Dim iLine As Integer
    Dim objPOC As cPOC
   
    If Not mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolPOCs.Count
        Set objPOC = mcolPOCs.Item(iLine)
        objPOC.CancelEdit
    Next
    mflgEditing = False
End Sub



and the contained, cPOC class:


Option Compare Database
Option Explicit

Private Type POCType
    PocID As Long
    DivID As Long
    FirstName As String
    LastName As String
    Phone As String
    PentagonOffice As String
    OtherLocation As String
    Primary As Boolean
End Type

Private mudtProps As POCType
Private mudtSave As POCType

Private mflgEditing As Boolean
Private mflgIsNew As Boolean
Private mflgDirty As Boolean
Private mDelete As Boolean

Public Property Get IsNew() As Boolean
    IsNew = mflgIsNew
End Property

Public Property Get PocID() As Long
    PocID = mudtProps.PocID
End Property

Public Property Get DivID() As Long
    DivID = mudtProps.DivID
End Property

Public Property Let DivID(lngValue As Long)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.DivID = lngValue
    If mudtSave.DivID <> mudtProps.DivID Then
        mflgDirty = True
    End If
End Property

Public Property Get FirstName() As String
    FirstName = mudtProps.FirstName & ""
End Property

Public Property Let FirstName(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.FirstName = strValue
    If Trim$(mudtSave.FirstName) <> Trim$(mudtProps.FirstName) Then
        mflgDirty = True
    End If
End Property

Public Property Get Primary() As Boolean
    Primary = mudtProps.Primary
End Property

Public Property Let Primary(boolValue As Boolean)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.Primary = boolValue
    If mudtSave.Primary <> mudtProps.Primary Then
        mflgDirty = True
    End If
End Property

Public Property Get PentagonOffice() As String
    PentagonOffice = mudtProps.PentagonOffice
End Property

Public Property Let PentagonOffice(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.PentagonOffice = strValue
    If Trim$(mudtSave.PentagonOffice) <> Trim$(mudtProps.PentagonOffice) Then
        mflgDirty = True
    End If
End Property

Public Property Get OtherLocation() As String
    OtherLocation = mudtProps.OtherLocation
End Property

Public Property Let OtherLocation(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.OtherLocation = strValue
    If Trim$(mudtSave.OtherLocation) <> Trim$(mudtProps.OtherLocation) Then
        mflgDirty = True
    End If
End Property


Public Property Get LastName() As String
    LastName = mudtProps.LastName
End Property

Public Property Let LastName(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.LastName = strValue
    If Trim$(mudtSave.LastName) <> Trim$(mudtProps.LastName) Then
        mflgDirty = True
    End If
End Property

Public Property Get Phone() As String
    Phone = mudtProps.Phone
End Property

Public Property Let Phone(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.Phone = strValue
    If Trim$(mudtSave.Phone) <> Trim$(mudtProps.Phone) Then
        mflgDirty = True
    End If
End Property


Public Sub BeginEdit()
    If mflgEditing Then Err.Raise 445
    mflgEditing = True
    mudtSave = mudtProps
End Sub

Public Sub ApplyEdit()
    If Not mflgEditing Then Err.Raise 445
    If mDelete Then
        DeleteObject PocID
    ElseIf mflgDirty Then
        Save
        mflgDirty = False
    End If
    mudtSave = mudtProps
    mflgEditing = False
    mflgIsNew = False
   
End Sub

Public Sub CancelEdit()
    If Not mflgEditing Then Err.Raise 445

    mudtProps = mudtSave
    mflgEditing = False
    mflgIsNew = False
   
End Sub

Public Sub Delete()
    mDelete = True
End Sub

Private Sub Class_Initialize()
    mflgIsNew = True
End Sub

Public Sub Load(PocID As Long, Optional DivID As Long = 0)
    Dim db As Database
    Dim strSQL As String
    Dim rsProject As Recordset
    On Error GoTo ErrorLog
    Set db = CurrentDb
    strSQL = "SELECT p.*, dp.divid, dp.Primary from tblPOC P LEFT JOIN tblDIVPOC DP " & _
        " on P.POCID = DP.POCID " & _
        " WHERE P.POCID = " & PocID

    If DivID > 0 Then
        strSQL = strSQL & " AND DP.DIVID = " & DivID
    End If
   
    Set rsProject = db.OpenRecordset(strSQL)
   
    With rsProject
        If Not .EOF Then
            mudtProps.PocID = PocID
            mudtProps.DivID = .Fields("DIVID")
            mudtProps.FirstName = .Fields("pocfname") & ""
            mudtProps.LastName = .Fields("pocLName") & ""
            mudtProps.Phone = .Fields("pocPhone") & ""
            mudtProps.PentagonOffice = .Fields("PentagonOffice") & ""
            mudtProps.OtherLocation = .Fields("OtherLocation") & ""
            mudtProps.Primary = .Fields("Primary")
        End If
        .Close
    End With
   
    mudtSave = mudtProps
    mflgIsNew = False
    mflgDirty = False
   
    Set rsProject = Nothing
    db.Close
    Set db = Nothing
    Exit Sub
ErrorLog:
    LogError "cPOC", "Load", Err.Number, Err.Description
    Resume Next
End Sub

Private Sub Save()
    Dim db As Database
    Dim strSQL As String
    Dim rsPOC As Recordset
    On Error GoTo ErrorLog
    Set db = CurrentDb
    strSQL = "SELECT * from tblPOC where POCID = " & PocID
   
    Set rsPOC = db.OpenRecordset(strSQL)
   
    With rsPOC
        If mflgIsNew Then
            .AddNew
        Else
            .Edit
        End If
        .Fields("POCFname") = mudtProps.FirstName
        .Fields("POCLName") = mudtProps.LastName
        .Fields("POCPhone") = mudtProps.Phone
        .Fields("PentagonOffice") = mudtProps.PentagonOffice
        .Fields("OtherLocation") = mudtProps.OtherLocation
        .Update
        If mflgIsNew Then
            .MoveLast
            mudtProps.PocID = .Fields("Pocid")
        End If
        .Close
    End With
   
    strSQL = "select * from tblDIVPOC where DIVID = " & DivID & _
        " AND POCID = " & PocID
    Set rsPOC = db.OpenRecordset(strSQL)
    With rsPOC
        If mflgIsNew Or .EOF Then
            .AddNew
            .Fields("POCID") = PocID
            .Fields("DIVID") = DivID
        Else
            .Edit
        End If
        .Fields("Primary") = mudtProps.Primary
        .Update
    End With
Exit_Sub:
           
    mudtSave = mudtProps
    mflgIsNew = False
    mflgDirty = False
   
    Set rsPOC = Nothing
    db.Close
    Set db = Nothing
    Exit Sub
ErrorLog:
    LogError "cPOC", "Save", Err.Number, Err.Description
    Resume Next

End Sub

Private Sub DeleteObject(PocID As Long)
    Dim strSQL As String
    Dim db As Database
   
    strSQL = "Delete from tblDIVPOC where DIVID = " & DivID & _
        " AND POCID = " & PocID
    Set db = CurrentDb
    db.Execute strSQL
    db.Close
    Set db = Nothing
   
End Sub


This is a small part of a rather extensive Contract Management application that I built for the Operations Office of the US Air Force in the Pentagon.

AW
Arthur_WoodCommented:
and here is some code for a fairly simple form, that consists of a ListBox control. populated with the contents of a Collection class:

Option Compare Database
Option Explicit
Private mProjectID As Long
Private mInvoiceAmount As Currency

Dim mDone As Boolean

Public Property Let ProjectNumber(ProjectNumber As String)
    lblProject.Caption = ProjectNumber
End Property

Public Property Let ProjectID(Amount As Currency, Project As Long)
    mProjectID = Project
    lstOpenODC.RowSource = "SELECT ODCID, Description, " & _
        "Format$([TotalCost],""$#,###.00"") AS [Estimated Cost]" & _
        " FROM tblODC WHERE NZ(ActCost,0)=0" & _
        " AND ProjectID = " & mProjectID

    mInvoiceAmount = Amount
   
End Property

Private Sub cmdDone_Click()
    mDone = True
   
End Sub

Public Property Get Done() As Boolean
    Done = mDone
End Property

Private Sub cmdView_Click()
    ViewODC
End Sub

Private Sub lstOpenODC_Click()
    cmdView.Enabled = True
End Sub

Private Sub lstOpenODC_DblClick(Cancel As Integer)
    If lstOpenODC.ListIndex > -1 Then
        ViewODC
    Else
        MsgBox "There appear to be no ODCs to view", vbOKOnly
    End If
   
End Sub

Private Sub ViewODC()
    Dim InvoiceODC As Form_frmInvoiceODC
    Dim iLoop As Integer
    On Error GoTo ErrorLog
   
    Screen.MousePointer = 11 ' busy
    Set InvoiceODC = New Form_frmInvoiceODC
   
    With InvoiceODC
        .ODCID(mInvoiceAmount, mProjectID) = lstOpenODC.Column(0, lstOpenODC.ListIndex + 1)
       
        .Visible = True
        Do While Not .Done
            If iLoop = 100 Then
                iLoop = 0
                DoEvents
            End If
            iLoop = iLoop + 1
        Loop
       
        .Visible = False
    End With
    Set InvoiceODC = Nothing
    lstOpenODC.Requery
    Exit Sub
ErrorLog:
    LogError "frmProjectODCs", "ViewODC", Err.Number, Err.Description
    Resume Next

End Sub

The Colection class, which supports the previous form:

Option Compare Database
Option Explicit

Private mcolODCs As Collection
Private mflgEditing As Boolean
Private Sub Class_Initialize()
    Set mcolODCs = New Collection
End Sub

Public Sub Load(Project As Long)
    Dim db As Database
    Dim strSQL As String
    Dim rsODCs As Recordset
    Dim objDisplay As cODC
   
    Set db = CurrentDb
    strSQL = "Select ODCID from tblODC where ProjectID =" & Project
   
    Set rsODCs = db.OpenRecordset(strSQL)
   
    With rsODCs
        Do While Not .EOF
            Set objDisplay = New cODC
            objDisplay.Load .Fields("ODCID")
            mcolODCs.Add objDisplay, CStr(objDisplay.ODCID) & "K"
            Set objDisplay = Nothing
            .MoveNext
        Loop
        .Close
    End With
   
    Set rsODCs = Nothing
    db.Close
    Set db = Nothing
   
           
End Sub
 
Public Function Count() As Integer
    Count = mcolODCs.Count
   
End Function

Public Function Item(ByVal Index As Variant) As cODC
    Dim iODC As Integer
    If mcolODCs.Count > 0 Then
        For iODC = 1 To mcolODCs.Count
            If mcolODCs.Item(iODC).ODCID = Val(Index) Then
                Set Item = mcolODCs.Item(iODC)
                Exit For
            End If
        Next
    End If
End Function

Public Function NewODC(Project As Long) As cODC
    Dim objODC As cODC
    Set objODC = New cODC
    objODC.BeginEdit
    objODC.ProjectID = Project
    Set NewODC = objODC
    Set objODC = Nothing
   
End Function

Public Sub AddODC(NewODC As cODC)
    mcolODCs.Add NewODC, CStr(NewODC.ODCID) & "K"
End Sub

Public Sub BeginEdit()
    Dim iLine As Integer
    Dim objODC As cODC
   
    If mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolODCs.Count
        Set objODC = mcolODCs.Item(iLine)
        objODC.BeginEdit
    Next
    mflgEditing = True
End Sub

Public Sub ApplyEdit()
    Dim iLine As Integer
    Dim objODC As cODC
   
    If Not mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolODCs.Count
        Set objODC = mcolODCs.Item(iLine)
        objODC.ApplyEdit
    Next
    mflgEditing = False
End Sub

Public Sub CancelEdit()
    Dim iLine As Integer
    Dim objODC As cODC
   
    If Not mflgEditing Then Err.Raise 445
   
    For iLine = 1 To mcolODCs.Count
        Set objODC = mcolODCs.Item(iLine)
        objODC.CancelEdit
    Next
    mflgEditing = False
End Sub


and the class which holds the individual members of the collection:


Option Compare Database
Option Explicit

Private Type ODCType
    ODCID As Long
    ProjectID As Long
    RequestDate As Variant
    PocID As Long
    POCPhone As String
    TotalCost As Currency
    ActCost As Currency
    Description As String
    Explanation As String
    VendorID As Long
    ApprovalID As Long
    ApprovalDate As Variant
    DocumentPath As String
End Type

Private mudtProps As ODCType
Private mudtSave As ODCType

Private mflgEditing As Boolean
Private mflgIsNew As Boolean
Private mflgDirty As Boolean
Private mflgDelete As Boolean

Public Property Get IsNew() As Boolean
    IsNew = mflgIsNew
End Property

Public Property Get isValid() As Integer
    isValid = 0
    If Not IsDate(mudtProps.RequestDate) Then
        isValid = isValid + 1
    End If
    If Len(mudtProps.Description & "") = 0 Then
        isValid = isValid + 2
    End If
    If EstCost <= 0 Then
        isValid = isValid + 4
    End If
    If PocID <= 0 Then
        isValid = isValid + 8
    End If
    If VendorID <= 0 Then
        isValid = isValid + 16
    End If

End Property

Public Property Get ODCID() As Long
    ODCID = mudtProps.ODCID
End Property

Public Sub Delete()
    mflgDelete = True
   
End Sub

Public Property Get ProjectID() As Long
    ProjectID = mudtProps.ProjectID
End Property

Public Property Let ProjectID(lngValue As Long)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.ProjectID = lngValue
    If mudtSave.ProjectID <> mudtProps.ProjectID Then
        mflgDirty = True
    End If
End Property

Public Property Get PocID() As Long
    PocID = mudtProps.PocID
End Property

Public Property Let PocID(lngValue As Long)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.PocID = lngValue
    If mudtSave.PocID <> mudtProps.PocID Then
        mflgDirty = True
    End If
End Property

Public Property Get VendorID() As Long
    VendorID = mudtProps.VendorID
End Property

Public Property Let VendorID(lngValue As Long)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.VendorID = lngValue
    If mudtSave.VendorID <> mudtProps.VendorID Then
        mflgDirty = True
    End If
End Property

Public Property Get ApprovalID() As Long
    ApprovalID = mudtProps.ApprovalID
End Property

Public Property Let ApprovalID(lngValue As Long)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.ApprovalID = lngValue
    If mudtSave.ApprovalID <> mudtProps.ApprovalID Then
        mflgDirty = True
    End If
End Property

Public Property Get RequestDate() As Date
    RequestDate = mudtProps.RequestDate
End Property

Public Property Let RequestDate(datValue As Date)
    If Not mflgEditing Then Err.Raise 445
    If IsDate(datValue) Then
        mudtProps.RequestDate = datValue
    Else
        mudtProps.RequestDate = Null
    End If
    If mudtSave.RequestDate <> mudtProps.RequestDate Then
        mflgDirty = True
    End If
End Property

Public Property Get ApprovalDate() As Variant
    ApprovalDate = mudtProps.ApprovalDate
End Property

Public Property Let ApprovalDate(varValue As Variant)
    If Not mflgEditing Then Err.Raise 445
    If IsDate(varValue) Then
        mudtProps.ApprovalDate = CDate(varValue)
    Else
        mudtProps.ApprovalDate = Null
    End If
    If mudtSave.ApprovalDate <> mudtProps.ApprovalDate Then
        mflgDirty = True
    End If
End Property

Public Property Get Description() As String
    Description = mudtProps.Description
End Property

Public Property Let Description(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.Description = strValue
    If Trim$(mudtSave.Description) <> Trim$(mudtProps.Description) Then
        mflgDirty = True
    End If
End Property

Public Property Get DocumentPath() As String
    DocumentPath = mudtProps.DocumentPath
End Property

Public Property Let DocumentPath(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.DocumentPath = strValue
    If Trim$(mudtSave.DocumentPath) <> Trim$(mudtProps.DocumentPath) Then
        mflgDirty = True
    End If
End Property

Public Property Get POCPhone() As String
    POCPhone = mudtProps.POCPhone
End Property


Public Property Get Explanation() As String
    Explanation = mudtProps.Explanation
End Property

Public Property Let Explanation(strValue As String)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.Explanation = strValue
    If Trim$(mudtSave.Explanation) <> Trim$(mudtProps.Explanation) Then
        mflgDirty = True
    End If
End Property

Public Property Get EstCost() As Currency
    EstCost = mudtProps.TotalCost
End Property

Public Property Let EstCost(curValue As Currency)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.TotalCost = curValue
    If mudtSave.TotalCost <> mudtProps.TotalCost Then
        mflgDirty = True
    End If
End Property

Public Property Get ActCost() As Currency
    ActCost = mudtProps.ActCost
End Property

Public Property Let ActCost(curValue As Currency)
    If Not mflgEditing Then Err.Raise 445
    mudtProps.ActCost = curValue
    If mudtSave.ActCost <> mudtProps.ActCost Then
        mflgDirty = True
    End If
End Property

Public Sub BeginEdit()
    If mflgEditing Then Err.Raise 445
    mflgEditing = True
    mudtSave = mudtProps
End Sub

Public Sub ApplyEdit()
    If Not mflgEditing Then Err.Raise 445
    If mflgDelete Then
        DeleteObject
    ElseIf mflgDirty Then
        Save
        mflgDirty = False
    End If
    mudtSave = mudtProps
    mflgEditing = False
    mflgIsNew = False
   
End Sub

Public Sub CancelEdit()
    If Not mflgEditing Then Err.Raise 445
   
    mudtProps = mudtSave
    mflgEditing = False
    mflgIsNew = False
   
End Sub

Private Sub Class_Initialize()
    mflgIsNew = True
End Sub

Public Sub Load(ODCID As Long)
    Dim db As Database
    Dim strSQL As String
    Dim rsODC As Recordset
    On Error GoTo ErrorLog
    Set db = CurrentDb
    strSQL = "SELECT o.* , op.Phone from tblODC o ,tlkpODCPOC op where o.ODCid = " & ODCID & _
        " AND op.pocid = o.pocid"
       
   
    Set rsODC = db.OpenRecordset(strSQL)
   
    With rsODC
        If Not .EOF Then
            mudtProps.ODCID = ODCID
            mudtProps.ProjectID = .Fields("ProjectID")
            mudtProps.ApprovalDate = .Fields("ApprovalDate")
            mudtProps.ApprovalID = Nz(.Fields("ApprovalID"), 0)
            mudtProps.Explanation = .Fields("Explanation") & ""
            mudtProps.Description = .Fields("Description") & ""
            mudtProps.DocumentPath = .Fields("DocumentPath") & ""
            mudtProps.PocID = .Fields("POCID")
            mudtProps.POCPhone = .Fields("Phone") & ""
            mudtProps.RequestDate = .Fields("Request")
            mudtProps.TotalCost = .Fields("TotalCost")
            mudtProps.ActCost = .Fields("ActCost")
           
            mudtProps.VendorID = Nz(.Fields("VendorID"), 0)
        End If
        .Close
    End With
   
    mudtSave = mudtProps
    mflgIsNew = False
    mflgDirty = False
   
    Set rsODC = Nothing
    db.Close
    Set db = Nothing
    Exit Sub
    Exit Sub
ErrorLog:
    LogError "cODC", "Load", Err.Number, Err.Description
    Resume Next

End Sub

Private Sub Save()
    Dim db As Database
    Dim strSQL As String
    Dim rsODC As Recordset
   
    Set db = CurrentDb
    strSQL = "SELECT * from tblODC where ODCID = " & ODCID
   
    Set rsODC = db.OpenRecordset(strSQL)
   
    With rsODC
        If mflgIsNew Then
            .AddNew
        Else
            .Edit
        End If
        .Fields("ProjectID") = mudtProps.ProjectID
        .Fields("ApprovalDate") = mudtProps.ApprovalDate
        .Fields("ApprovalID") = mudtProps.ApprovalID
        .Fields("Explanation") = mudtProps.Explanation
        .Fields("Description") = mudtProps.Description
        .Fields("DocumentPath") = mudtProps.DocumentPath
        .Fields("POCID") = mudtProps.PocID
        .Fields("Request") = mudtProps.RequestDate
        .Fields("TotalCost") = mudtProps.TotalCost
        .Fields("ActCost") = mudtProps.ActCost
        .Fields("VendorID") = mudtProps.VendorID
        .Update
        If mflgIsNew Then
            .MoveLast
            mudtProps.ODCID = .Fields("ODCID")
        End If
        .Close
    End With
           
   
    mudtSave = mudtProps
    mflgIsNew = False
    mflgDirty = False
   
    Set rsODC = Nothing
    db.Close
    Set db = Nothing
End Sub

Private Sub DeleteObject()
    Dim db As Database
   
    Set db = CurrentDb
   
    db.Execute "Delete from tblODC where ODCID = " & ODCID
    db.Close
    Set db = Nothing
   
End Sub


That should give you something to 'chew' on for a while.

AW

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.