Building a Library of Routines for Updating – #2

You are here (Click to enlarge)

Last post provided SQL_Add_Update_Funtions.  This entry provides the next level up to the routines that relies on SQL_Add_Update_Functions.  The basic syntax of an SQL Update statement is:

UPDATE table_name
SET    column1=value, column2=value2,...
WHERE  some_column1=some_value1
  AND  some_column2=some_value2 ...

To build this statement, we have two routines.  One creates the “column=value” pairs of the “SET” clause , and the other creates the “WHERE” clause.    The column/field names come from the Fields Definition Table and the values come from the end user’s entries in the “Data” range.

There’s not any magic in either of these routines and I believe the in-code documentation expains things well enough, so without any further pontification, here are the next set of routines to add.  These should go into “modTableUpdate”.

Function Build_SQL_Update_Values(sFields As String, sTable As String, _
                                 sDataRange As String, lRecord As Long, _
                                 bRows As Boolean) As String

'   Description:Format field/column names & values for an SQL "Update" statement

'   Parameters: sFields:Range name containing field definitions
'                       Field:  Database Field/Column names
'                       Key:    Which fields are part of the unique key
'                       Table:  Database table/file name to update
'               sTable: Database table/file name to update
'               sDataRange: Range name that holds the values/data
'               lRecord: Record in sDataRange being updated (Row# if bRows=True)
'               bRows:  True means each record is in a row
'   Example:   
'	sSQL = _
'            "Update  " & sTable & " " & _
'            "Set    " & _
'             Build_SQL_Update_Values("Fields","Products","Data",1,True) & " " & _
'            "Where   " & _
'             Build_SQL_UpdDlt_Where_Clause("Fields","Products","Data",1,True)

'     Date   Init Modification
'   01/01/01 CWH  Initial Programming

    On Error GoTo ErrHandler
    Build_SQL_Update_Values = "" 'Assume Something went wrong
   
    Dim lRow As Long
    Dim sSQL As String
    Dim sCRTB As String
    Dim sValue As String        'Current Value of the field being processed
    Dim sScreenField As String  'Screen Name of Current Field being processed
    Dim sTableField As String   'Table Name of Current Field being processed

    sCRTB = vbCr & vbTab & vbTab

    If sFields <= "" Then Exit Function
   
    sSQL = ""
    With Range(sFields)
        For lRow = 2 To .Rows.Count
            'Include only fields from stable and not part of the Primary Key
            If .Cells(lRow, FieldColumn("Table", sFields)) = sTable And Not _
                .Cells(lRow, FieldColumn("Key", sFields)) >= "A" Then
                sTableField = .Cells(lRow, FieldColumn("Field", sFields))
                sScreenField = .Cells(lRow, FieldColumn("Heading", sFields))
                If bRows Then
                    sValue = Range(sDataRange).Cells(lRecord + 1, _
                             FieldColumn(sScreenField, sDataRange))
                Else
                    sValue = Range(sDataRange).Cells( _
                             FieldRow(sScreenField, sDataRange), _
                             lRecord + 1)
                End If
                sSQL = sSQL & IIf(sSQL > "", ", " & sCRTB, "") & _
                       sTableField & " = " & _
                       SQL_Add_Update_Functions(sValue, lRow, sFields)
            End If
        Next lRow
    End With
   
    Build_SQL_Update_Values = sSQL

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Build_SQL_Update_Values - Error#" & Err.Number & vbCrLf & _
         Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Build_SQL_UpdDlt_Where_Clause(sFields As String, sTable As String, _
				  sDataRange As String, lRecord As Long, _
				  bRows As Boolean) As String
   
'   Description:Create SQL Where clause for SQL "Update" or "Insert" statement

'   Parameters: sFields:Range name containing field definitions
'                       Field:  Database Field/Column names
'                       Key:    Which fields are part of the unique key
'                       Table:  Database table/file name to update
'               sTable: Database table/file name to update
'               sDataRange: Range name that holds the values/data
'               lRecord: Record in sDataRange being updated (Row# if bRows=True)
'               bRows:  True means each record is in a row
'   Example:   
'	sSQL = _
'            "Update  " & sTable & " " & _
'            "Set    " & _
'             Build_SQL_Update_Values("Fields","Products","Data",1,True) & " " & _
'            "Where   " & _
'             Build_SQL_UpdDlt_Where_Clause("Fields","Products","Data",1,True)

'     Date   Init Modification
'   01/01/01 CWH  Initial Programming

    On Error GoTo ErrHandler
    Build_SQL_UpdDlt_Where_Clause = ""    'Assume Something went wrong

    Dim lRow As Long
    Dim sSQL As String
    Dim sCRTB As String
    Dim sValue As String        'Current Value of the field being processed
    Dim sScreenField As String  'Screen Name of Current Field being processed
    Dim sTableField As String   'Table Name of Current Field being processed
   
    If sFields <= "" Then Exit Function
   
    sSQL = ""
    With Range(sFields)
        For lRow = 2 To .Rows.Count
            'Include only fields from stable and not part of the Primary Key
            If .Cells(lRow, FieldColumn("Table", sFields)) = _
                sTable And .Cells(lRow, FieldColumn("Key", sFields)) >= "A" Then
                sTableField = .Cells(lRow, FieldColumn("Field", sFields))
                sScreenField = .Cells(lRow, FieldColumn("Heading", sFields))
                If bRows Then
                    sValue = Range(sDataRange).Cells(lRecord + 1, _
                        FieldColumn(sScreenField, sDataRange))
                Else
                    sValue = Range(sDataRange).Cells( _
                             FieldRow(sScreenField, sDataRange), _
                             lRecord + 1)
                End If
                sSQL = sSQL & IIf(sSQL <= "", "", vbCr & "  And   ") & _
                       .Cells(lRow, FieldColumn("Field", sFields)) & " = " & _
                       SQL_Add_Update_Functions(sValue, lRow, sFields)
            End If
        Next lRow
    End With
   
    Build_SQL_UpdDlt_Where_Clause = sSQL

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Build_SQL_UpdDlt_Where_Clause - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function