Beyond Excel: VBA and Database Manipulation

Apr 20 2010   1:16PM GMT

Building a Library of Routines for Updating – #2

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

You are here (Click to enlarge)

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

 Comment on this Post

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: