Warthware Logo
Building blocks for better software ...

Visual Basic Create, Read Update and Delete (CRUD) Form Screen Shot:

Visual Basic Create, Read Update and Delete (CRUD) Cursor Form Screen Shot:

Visual Basic Create, Read Update and Delete (CRUD) Form Source:

VERSION 5.00
Begin VB.Form frmCode
   BorderStyle     =   1
   Caption         =   "Code CRUD"
   ClientHeight    =   6210
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11010
   LinkTopic       =   "Code CRUD"
   MaxButton       =   0
   MinButton       =   0
   ScaleHeight     =   6210
   ScaleWidth      =   11010
   StartUpPosition =   3
   MDIChild        =   -1
   Begin VB.Label labQuery
      Caption = "Query"
      Height = 255
      Left = 4200
      TabIndex = 900
      Top = 360
      Width = 2415
   End
   Begin VB.Label labUpdateFields
      Caption = "Update Fields"
      Height = 255
      Left = 7560
      TabIndex = 901
      Top = 360
      Width = 2415
   End
   Begin VB.Label labComment
      Caption = "* Key field "
      Height = 255
      Left = 120
      TabIndex = 903
      Top = 3960
      Width = 735
   End
   Begin VB.CommandButton cmdAdd
      Caption = "&Add"
      Height = 375
      Left = 120
      TabIndex = 0
      Top = 120
      Width = 1455
   End
   Begin VB.CommandButton cmdGetUnique
      Caption = "&Get Unique"
      Height = 375
      Left = 120
      TabIndex = 1
      Top = 600
      Width = 1455
   End
   Begin VB.CommandButton cmdUpdate
      Caption = "&Update"
      Height = 375
      Left = 120
      TabIndex = 2
      Top = 1080
      Width = 1455
   End
   Begin VB.CommandButton cmdDelete
      Caption = "&Delete"
      Height = 375
      Left = 120
      TabIndex = 3
      Top = 1560
      Width = 1455
   End
   Begin VB.CommandButton cmdOpenCursor
      Caption = "&Cursor"
      Height = 375
      Left = 120
      TabIndex = 4
      Top = 2040
      Width = 1455
   End
   Begin VB.CommandButton cmdCount
      Caption = "C&ount"
      Height = 375
      Left = 120
      TabIndex = 5
      Top = 2520
      Width = 1455
   End
   Begin VB.CommandButton cmdClear
      Caption = "&Clear"
      Height = 375
      Left = 120
      TabIndex = 6
      Top = 3000
      Width = 1455
   End
   Begin VB.CommandButton cmdExit
      Caption = "E&xit"
      Height = 375
      Left = 120
      TabIndex = 7
      Top = 3480
      Width = 1455
   End
   Begin VB.Label labCodeType
      Caption = "Code Type*"
      Height = 255
      Left = 1800
      TabIndex = 8
      Top = 600
      Width = 3015
   End
   Begin VB.Label labCode
      Caption = "Code*"
      Height = 255
      Left = 1800
      TabIndex = 9
      Top = 960
      Width = 3015
   End
   Begin VB.Label labDecode
      Caption = "Decode"
      Height = 255
      Left = 1800
      TabIndex = 10
      Top = 1320
      Width = 3015
   End
   Begin VB.Label labDescription
      Caption = "Description"
      Height = 255
      Left = 1800
      TabIndex = 11
      Top = 1680
      Width = 3015
   End
   Begin VB.Label labUserid
      Caption = "Userid"
      Height = 255
      Left = 1800
      TabIndex = 12
      Top = 2040
      Width = 3015
   End
   Begin VB.Label labUpdateTimestamp
      Caption = "Update Timestamp"
      Height = 255
      Left = 1800
      TabIndex = 13
      Top = 2400
      Width = 3015
   End
   Begin VB.TextBox txtCodeType
      Height = 285
      Left = 4200
      TabIndex = 14
      Top = 600
      Width = 3255
   End
   Begin VB.TextBox txtUpdCodeType
      Height = 285
      Left = 7560
      TabIndex = 15
      Top = 600
      Width = 3255
   End
   Begin VB.TextBox txtCode
      Height = 285
      Left = 4200
      TabIndex = 16
      Top = 960
      Width = 3255
   End
   Begin VB.TextBox txtUpdCode
      Height = 285
      Left = 7560
      TabIndex = 17
      Top = 960
      Width = 3255
   End
   Begin VB.TextBox txtDecode
      Height = 285
      Left = 4200
      TabIndex = 18
      Top = 1320
      Width = 3255
   End
   Begin VB.TextBox txtUpdDecode
      Height = 285
      Left = 7560
      TabIndex = 19
      Top = 1320
      Width = 3255
   End
   Begin VB.TextBox txtDescription
      Height = 285
      Left = 4200
      TabIndex = 20
      Top = 1680
      Width = 3255
   End
   Begin VB.TextBox txtUpdDescription
      Height = 285
      Left = 7560
      TabIndex = 21
      Top = 1680
      Width = 3255
   End
   Begin VB.TextBox txtUserid
      Height = 285
      Left = 4200
      TabIndex = 22
      Top = 2040
      Width = 3255
   End
   Begin VB.TextBox txtUpdUserid
      Height = 285
      Left = 7560
      TabIndex = 23
      Top = 2040
      Width = 3255
   End
   Begin VB.TextBox txtUpdateTimestamp
      Height = 285
      Left = 4200
      TabIndex = 24
      Top = 2400
      Width = 3255
   End
   Begin VB.TextBox txtUpdUpdateTimestamp
      Height = 285
      Left = 7560
      TabIndex = 25
      Top = 2400
      Width = 3255
   End
End
Attribute VB_Name = "frmCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
    Dim strMessage, strTitle As String
    Dim intReturn As Integer
    Dim objCode As Code
    Set objCode = New Code
    With objCode
        If Len(txtCodeType) > 0 Then
           .CodeType = txtCodeType
        End If
        If Len(txtCode) > 0 Then
           .Code = txtCode
        End If
        If Len(txtDecode) > 0 Then
           .Decode = txtDecode
        End If
        If Len(txtDescription) > 0 Then
           .Description = txtDescription
        End If
        If Len(txtUserid) > 0 Then
           .Userid = txtUserid
        End If
        If Len(txtUpdateTimestamp) > 0 Then
           .UpdateTimestamp = txtUpdateTimestamp
        End If
        intReturn = .AddCode
        If intReturn <> 0 Then
            strMessage = "Error Code: " & intReturn
            strTitle = "Error"
            intReturn = MsgBox(strMessage, , strTitle)
        Else
            strMessage = "Success!"
            strTitle = "Success"
            intReturn = MsgBox(strMessage, , strTitle)
        End If
    End With
End Sub
Private Sub cmdClear_Click()
    txtCodeType = ""
    txtUpdCodeType = ""
    txtCode = ""
    txtUpdCode = ""
    txtDecode = ""
    txtUpdDecode = ""
    txtDescription = ""
    txtUpdDescription = ""
    txtUserid = ""
    txtUpdUserid = ""
    txtUpdateTimestamp = ""
    txtUpdUpdateTimestamp = ""
End Sub
Private Sub cmdDelete_Click()
    Dim strMessage, strTitle As String
    Dim intReturn As Integer
    Dim objCode As Code
    Set objCode = New Code
    With objCode
        If Len(txtCodeType) > 0 Then
           .CodeType = txtCodeType
        End If
        If Len(txtCode) > 0 Then
           .Code = txtCode
        End If
        If Len(txtDecode) > 0 Then
           .Decode = txtDecode
        End If
        If Len(txtDescription) > 0 Then
           .Description = txtDescription
        End If
        If Len(txtUserid) > 0 Then
           .Userid = txtUserid
        End If
        If Len(txtUpdateTimestamp) > 0 Then
           .UpdateTimestamp = txtUpdateTimestamp
        End If
        intReturn = .DelCode
        If intReturn <> 0 Then
            strMessage = "Error Code: " & intReturn
            strTitle = "Error"
            intReturn = MsgBox(strMessage, , strTitle)
        Else
            strMessage = "Success!"
            strTitle = "Success"
            intReturn = MsgBox(strMessage, , strTitle)
        End If
    End With
End Sub
Private Sub cmdGetUnique_Click()
    Dim strMessage, strTitle As String
    Dim intReturn As Integer
    Dim objCode As Code
    Set objCode = New Code
    With objCode
        If Len(txtCodeType) > 0 Then
           .CodeType = txtCodeType
        End If
        If Len(txtCode) > 0 Then
           .Code = txtCode
        End If
        intReturn = .GetUniqueCode
        If intReturn <> 0 Then
            strMessage = "Error Code: " & intReturn
            strTitle = "Error"
            intReturn = MsgBox(strMessage, , strTitle)
        Else
           txtDecode = .Decode
           txtDescription = .Description
           txtUserid = .Userid
           txtUpdateTimestamp = .UpdateTimestamp
        End If
    End With
End Sub
Private Sub cmdOpenCursor_Click()
    frmCode_Cursor.Show
End Sub
Private Sub cmdCount_Click()
    Dim strMessage, strTitle As String
    Dim intReturn As Integer
    Dim objCode As Code
    Set objCode = New Code
    With objCode
        If Len(txtCodeType) > 0 Then
           .CodeType = txtCodeType
        End If
        If Len(txtCode) > 0 Then
           .Code = txtCode
        End If
        If Len(txtDecode) > 0 Then
           .Decode = txtDecode
        End If
        If Len(txtDescription) > 0 Then
           .Description = txtDescription
        End If
        If Len(txtUserid) > 0 Then
           .Userid = txtUserid
        End If
        If Len(txtUpdateTimestamp) > 0 Then
           .UpdateTimestamp = txtUpdateTimestamp
        End If
        intReturn = .CntCode
        If intReturn <> 0 Then
            strMessage = "Error Code: " & intReturn
            strTitle = "Error"
            intReturn = MsgBox(strMessage, , strTitle)
        Else
            strMessage = "Rows Found: " & .RowsAffected
            strTitle = "Rows Found"
            intReturn = MsgBox(strMessage, , strTitle)
        End If
    End With
End Sub
Private Sub cmdUpdate_Click()
    Dim strMessage, strTitle As String
    Dim intReturn As Integer
    Dim objCode As Code
    Set objCode = New Code
    With objCode
        If Len(txtCodeType) > 0 Then
           .CodeType = txtCodeType
        End If
        If Len(txtUpdCodeType) > 0 Then
           .CodeTypeUpdVal = txtUpdCodeType
        End If
        If Len(txtCode) > 0 Then
           .Code = txtCode
        End If
        If Len(txtUpdCode) > 0 Then
           .CodeUpdVal = txtUpdCode
        End If
        If Len(txtDecode) > 0 Then
           .Decode = txtDecode
        End If
        If Len(txtUpdDecode) > 0 Then
           .DecodeUpdVal = txtUpdDecode
        End If
        If Len(txtDescription) > 0 Then
           .Description = txtDescription
        End If
        If Len(txtUpdDescription) > 0 Then
           .DescriptionUpdVal = txtUpdDescription
        End If
        If Len(txtUserid) > 0 Then
           .Userid = txtUserid
        End If
        If Len(txtUpdUserid) > 0 Then
           .UseridUpdVal = txtUpdUserid
        End If
        If Len(txtUpdateTimestamp) > 0 Then
           .UpdateTimestamp = txtUpdateTimestamp
        End If
        If Len(txtUpdUpdateTimestamp) > 0 Then
           .UpdateTimestampUpdVal = txtUpdUpdateTimestamp
        End If
        intReturn = .UpdCode
        If intReturn <> 0 Then
            strMessage = "Error Code: " & intReturn
            strTitle = "Error"
            intReturn = MsgBox(strMessage, , strTitle)
        Else
            strMessage = "Success!"
            strTitle = "Success"
            intReturn = MsgBox(strMessage, , strTitle)
        End If
    End With
End Sub
Private Sub cmdExit_Click()
    End
End Sub

Copyright © 2002 - 2020, Donald R. Warth Jr.
All rights reserved.