Warthware Logo
Building blocks for better software ...

Sample ActiveX Source with Add Method:

'Name        : Code
'Author      : Don Warth
'Description : A code lookup table with a type grouping
'Properties  : CodeType
'              CodeTypeUpdVal
'              CodeTypeInd
'              Code
'              CodeUpdVal
'              CodeInd
'              Decode
'              DecodeUpdVal
'              DecodeInd
'              Description
'              DescriptionUpdVal
'              DescriptionInd
'              Userid
'              UseridUpdVal
'              UseridInd
'              UpdateTimestamp
'              UpdateTimestampUpdVal
'              UpdateTimestampInd
'              RowsAffected
'              ErrorMessage
'              ConnectionString
'              conConnection
'              rstRecordset
'              bolEOF
'              strSQLQuery
'Methods     : AddCode
'              DelCode
'              UpdOneCode
'              UpdCode
'              GetUniqueCode
'              OpenCursorCode
'              CloseCursorCode
'              FetchNextCode
'              CntCode
'Errors      : 10 - Attempted to add record already present on the file
'              11 - Attempted to add record without all key values specified
'              20 - Exactly 1 record was not found on get
'              30 - Record not found on delete
'              40 - Record not found on update
'              50 - Cursor contains no records
'              100 - EOF cursor processing

Option Explicit

Private strCodeType As String
Private strCodeTypeInd As String
Private strCodeTypeUpdVal As String
Private strCodeTypeUpdValInd As String
Private strCode As String
Private strCodeInd As String
Private strCodeUpdVal As String
Private strCodeUpdValInd As String
Private strDecode As String
Private strDecodeInd As String
Private strDecodeUpdVal As String
Private strDecodeUpdValInd As String
Private strDescription As String
Private strDescriptionInd As String
Private strDescriptionUpdVal As String
Private strDescriptionUpdValInd As String
Private strUserid As String
Private strUseridInd As String
Private strUseridUpdVal As String
Private strUseridUpdValInd As String
Private datUpdateTimestamp As Date
Private strUpdateTimestampInd As String
Private datUpdateTimestampUpdVal As Date
Private strUpdateTimestampUpdValInd As String
Private intRowsAffected As Integer
Private strErrorMessage As String
Private strConnectionString As String
Private conConnection As Connection
Private rstRecordset As Recordset
Private bolEOF As Boolean
Private strSQLQuery As String

Public Property Get CodeType() As String
     CodeType = strCodeType
End Property

Public Property Get CodeTypeInd() As String
     CodeTypeInd = strCodeTypeInd
End Property

Public Property Let CodeType(strInput As String)
     strCodeType = strInput
     strCodeTypeInd = "Y"
End Property

Public Property Let CodeTypeUpdVal(strInput As String)
     strCodeTypeUpdVal = strInput
     strCodeTypeUpdValInd = "Y"
End Property

Public Property Get Code() As String
     Code = strCode
End Property

Public Property Get CodeInd() As String
     CodeInd = strCodeInd
End Property

Public Property Let Code(strInput As String)
     strCode = strInput
     strCodeInd = "Y"
End Property

Public Property Let CodeUpdVal(strInput As String)
     strCodeUpdVal = strInput
     strCodeUpdValInd = "Y"
End Property

Public Property Get Decode() As String
     Decode = strDecode
End Property

Public Property Get DecodeInd() As String
     DecodeInd = strDecodeInd
End Property

Public Property Let Decode(strInput As String)
     strDecode = strInput
     strDecodeInd = "Y"
End Property

Public Property Let DecodeUpdVal(strInput As String)
     strDecodeUpdVal = strInput
     strDecodeUpdValInd = "Y"
End Property

Public Property Get Description() As String
     Description = strDescription
End Property

Public Property Get DescriptionInd() As String
     DescriptionInd = strDescriptionInd
End Property

Public Property Let Description(strInput As String)
     strDescription = strInput
     strDescriptionInd = "Y"
End Property

Public Property Let DescriptionUpdVal(strInput As String)
     strDescriptionUpdVal = strInput
     strDescriptionUpdValInd = "Y"
End Property

Public Property Get Userid() As String
     Userid = strUserid
End Property

Public Property Get UseridInd() As String
     UseridInd = strUseridInd
End Property

Public Property Let Userid(strInput As String)
     strUserid = strInput
     strUseridInd = "Y"
End Property

Public Property Let UseridUpdVal(strInput As String)
     strUseridUpdVal = strInput
     strUseridUpdValInd = "Y"
End Property

Public Property Get UpdateTimestamp() As Date
     UpdateTimestamp = datUpdateTimestamp
End Property

Public Property Get UpdateTimestampInd() As String
     UpdateTimestampInd = strUpdateTimestampInd
End Property

Public Property Let UpdateTimestamp(datInput As Date)
     datUpdateTimestamp = datInput
     strUpdateTimestampInd = "Y"
End Property

Public Property Let UpdateTimestampUpdVal(datInput As Date)
     datUpdateTimestampUpdVal = datInput
     strUpdateTimestampUpdValInd = "Y"
End Property

Public Property Get RowsAffected() As Integer
     RowsAffected = intRowsAffected
End Property

Public Property Get ErrorMessage() As String
     ErrorMessage = strErrorMessage
End Property

Public Property Get ConnectionString() As String
     ConnectionString = strConnectionString
End Property

Public Property Let ConnectionString(strInput As String)
     strConnectionString = strInput
End Property

Public Property Get EOF() As Boolean
     EOF = bolEOF
End Property

Public Property Get SQLQuery() As String
     SQLQuery = strSQLQuery
End Property

Function AddCode()
   Dim strInsert, strFields, strValues, strSQL, strConnectionString As String
   Dim intNumRecords, intReturn, intMissingKeyCount As Integer
   intReturn = 0

   If strConnectionString = "" Then
      strConnectionString = "Data Source='RepositoryProd'"
   End If

   Set conConnection = CreateObject("ADODB.Connection")
   conConnection.Open strConnectionString
   intMissingKeyCount = 0

   If strCodeTypeInd <> "Y" Then
      intMissingKeyCount = intMissingKeyCount + 1
   End If

   If strCodeInd <> "Y" Then
      intMissingKeyCount = intMissingKeyCount + 1
   End If

   If intMissingKeyCount > 0 Then
      intReturn = 11
   End If

   If intReturn = 0 Then
      strSQL = "SELECT COUNT(*) AS [NumRecords] FROM tblCode WHERE"
      If strCodeTypeInd = "Y" Then
         strSQL = strSQL & " [Code_Type] = '" & strCodeType & "'"
      End If
      If strCodeInd = "Y" Then
         strSQL = strSQL & " AND [Code] = '" & strCode & "'"
      End If
      strSQL = strSQL & ";"

      Set rstRecordset = conConnection.Execute(strSQL)
      intNumRecords = rstRecordset("NumRecords")
      rstRecordset.Close
      If intNumRecords > 0 Then
          intReturn = 10
      End If
   End If
   If intReturn = 0 Then

      strInsert = "INSERT INTO tblCode"
      strFields = " ("
      strValues = " VALUES ("

      If strCodeTypeInd = "Y" Then
         strFields = strFields & "[Code_Type]"
         strValues = strValues & " '" & strCodeType & "'"
      End If

      If strCodeInd = "Y" Then
         strFields = strFields & ", [Code]"
         strValues = strValues & ",  '" & strCode & "'"
      End If

      If strDecodeInd = "Y" Then
         strFields = strFields & ", [Decode]"
         strValues = strValues & ",  '" & strDecode & "'"
      End If

      If strDescriptionInd = "Y" Then
         strFields = strFields & ", [Description]"
         strValues = strValues & ",  '" & strDescription & "'"
      End If

      If strUseridInd = "Y" Then
         strFields = strFields & ", [Userid]"
         strValues = strValues & ",  '" & strUserid & "'"
      End If

      If strUpdateTimestampInd = "Y" Then
         strFields = strFields & ", [Update_Timestamp]"
         strValues = strValues & ",  '" & datUpdateTimestamp & "'"
      End If

      strFields = strFields & ")"
      strValues = strValues & ")"
      strSQL = strInsert & strFields & strValues & ";"
      strSQLQuery = strSQL

      Set rstRecordset = conConnection.Execute(strSQL)
      conConnection.Close
      If intReturn = 0 Then
         intRowsAffected = 1
      Else
         intRowsAffected = 0
      End If
   End If
   AddCode = intReturn

End Function


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