Building a Library of Routines for Updating – #7

You are here (Click to enlarge)

As you can see from the simple DFD at right, we are almost done writing update routines.  Hopefully you are asking an important question.  Hopefully you are wondering why I haven’t covered an extremely important topic.  Hopefully you want to know how we make sure the data is correct BEFORE we update anything.

Function Post(sConnect As String, sWorksheet As String, _
              sHeaderFields As String, sDetailFields As String, _
              sHeaderRange As String, sDetailRange As String, _
              sTable As String) As Boolean

'   Description:Post entries from a spreadsheet to a database table

'   Parameters: sWorksheet      Worksheet containing entries
'               sHeaderFields   Header Field descriptions range
'                               (on Tables Tab - Optional)
'               sDetailFields   Detail Field descriptions range
'               sHeaderRange    Range containing values common to all
'		              update records (Optional)
'               sDetailRange    Range containing entry rows
'               sTable          Table Name that will be updated
'			    (there can be only one)
'   Example:    bResult = Post(sConnectionString, _
'                              sDataWorkSheet, _
'                              sHeaderFieldDefinitions, _
'                              sDetailFieldDefinitions, _
'                              sHeaderData, _
'                              sDetailData, _
'                              sUpdateTable)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
   
    On Error GoTo ErrHandler    '
    Post = Failure              'Assume Something went wrong
   
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
   
    Dim lRow As Long
    Dim bResult As Boolean
   
    bResult = Worksheets(sWorksheet).Check_Entry( _
                  Range(sDetailRange & "_Data"), _
                  sDetailRange, sDetailFields)
    If bResult <> Success Then
        MsgBox "Errors exist.  " & _
               "Correct first, the press 'Done'", vbOKOnly, "Errors"
    Else
        bResult = Update_Entries(sConnect, sWorksheet, _
                                 sHeaderRange, sDetailRange, _
                                 sHeaderFields, sDetailFields, _
                                 sTable, True)
    End If
   
    Post = bResult
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Post - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"              'Restore application settings
    On Error GoTo 0

End Function

Building a Library of Routines for Updating – #6

Your are here (Click to enlarge)

This post’s routine, Update_Entries, cycles through all the records in an Excel range and updates any pending entries using the Update_Entry function from last post.

You may wonder why I have a single record update routine (SRUR) and a multiple record update routine (MRUR).  Why not just write a larger routine that does both?  The answer is that by having an SRUR, I can test that specific functionality very easily and I have what amounts to an entry point into the MRUR when I want to update just one record.  Since the MRUR leverages the SRUR, none of the SRUR code is duplicated in the MRUR except error handling.  However, having the routines split does cause one problem - mutliple database opens and closes.

Multliple database opens and closes slows things down dramatically.  In order to maintain speed, the SRUR accepts a connection object as well as a connection string.  If the connection object is provided, the SRUR leverages that and avoids creating its own connection to the database.  So to support that goal, we have a routine that creates a connection object that can be passed between functions – SQLConnection.

Here is the code:

Function SQLConnection(cn As ADODB.Connection, _
                       sConnect As String) As Boolean

'   Description:Create a connection to the database
'               By externalizing this, a connection can be created and reused

'   Parameters: cn - an ADODB connection object
'               sConnect - a connection string
'   Example:    bResult =  SQLConnection( _
                           cn, _
                           "Driver={Microsoft Access Driver (*.mdb)};" & _
                           "DBQ=c:\Northwind.mdb")

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

    On Error GoTo ErrHandler
    SQLConnection = Failure    'Assume Something went wrong
   
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
    End If
   
    SQLConnection = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "SQLConnection - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Public Function Update_Entries(sConnect As String, sWorksheet As String, _
                               sHeaderRange As String, sDetailRange As String, _
                               sHeaderFields As String, sDetailFields As String, _
                               sTable As String, bRows As Boolean) As Boolean

'   Description:Update a ALL entries (entires MUST be verfied first)

'   Parameters: sConnect       ODBC Connection String
'               sWorksheet     Worksheet containing data
'               sHeaderRange   Range holding values common to all records (Opt.)
'               sDetailRange   Range holding unique rows of data
'               sHeaderFields  Range holding common field descriptions (Opt.)
'               sDetailFields  Range holding unique row field descriptions
'               sTable         Table to be updated (there can be only one)
'               bRows          "True" if entries in rows, "False" if in columns
'   Example:    bResult = Update_Entries(sConnectionString, _
                                         sDataWorkSheet, _
                                         sHeaderData, _
                                         sDetailData, _
                                         sHeaderFieldDefinitions, _
                                         sDetailFieldDefinitions, _
                                         sUpdateTable, _
                                         True)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming

    On Error GoTo ErrHandler
    Update_Entries = Success    'Assume the Best 
    
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
   
    Dim lRow As Long            'Current Row
    Dim lRows As Long           'Number of Rows in sDetailRange
    Dim iACD As Integer         'Column holding ACD (Add,Change,Delete) instr.
    Dim iErrMsg As Integer      'Column to report Error Messages
    Dim bResult As Boolean      'Generic Result variable (Success or Failure)
    Dim cn As ADODB.Connection  'ADO Connection Object (Optional-use this when
                                'updating several records to avoid unnecessary
                                'DB opens and closes)
       
    'Establish connection to the database or fail this routine
    bResult = SQLConnection(cn, sConnect)
    Update_Entries = bResult
    If bResult = Failure Then Exit Function
  
    iACD = FieldColumn("ACD", sDetailRange)         'Must have "ACD" column
    iErrMsg = FieldColumn("ERRORS", sDetailRange)   'and an "ERRORS" column
    lRows = Range(sDetailRange).Rows.Count          'Number of data rows

    With frmProgress                                'Show Progress Bar
        .pPct = 0
        .pCaption = "Updating Entries"
        .Show False
    End With
                       
    Debug.Print "Start: "; Now()                'Start timer(for pgmr feedback)
    With Range(sDetailRange)                    'Go through all records
        lRow = 2                                'Skip column headings
        While lRow <= .Row + .Rows.Count        'Update the database
            If .Cells(lRow, iACD) > "" And _
                InStr(1, "ACD", .Cells(lRow, iACD)) > 0 Then
                bResult = Update_Entry(sConnect, sWorksheet, _
                                       sHeaderRange, sDetailRange, _
                                       sHeaderFields, sDetailFields, _
                                       sTable, lRow, iACD, iErrMsg, cn)
                If bResult = Failure Then Update_Entries = Failure
            End If
            lRow = lRow + 1
            frmProgress.pPct = lRow / lRows
        Wend
       
        lRow = 2                                'Remove deteled rows
        While lRow <= .Row + .Rows.Count
            If .Cells(lRow, iACD) = "D" And _
               .Cells(lRow, iErrMsg) = "Updated!" Then
                Rows(.Cells(lRow, 1).Row).Delete Shift:=xlUp
            Else
                lRow = lRow + 1
            End If
        Wend
    End With
    Debug.Print "End: "; Now()                  'Stop the update timer
               
    cn.Close                                    'Close connection
    frmProgress.Hide                            'Close Progress Bar

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Update_Entries - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"                  'Restore application settings
    On Error GoTo 0

End Function

Building a Library of Routines for Updating – #5

You are here (click to enlarge)

Update_Entry updates a single record.  Its parent handles cycling through all Excel entries, passing them one by one to Update_Entry.  We will see that routine in the next post.  Here is the code for Update_Entry.

Public Function Update_Entry(sConnect As String, sWorksheet As String, _
                             sData As String, sFields As String, _
                             sPath As String, lRow As Long, _
                             iACD As Integer, iNotes As Integer, _
                             Optional cn As ADODB.Connection) As Boolean
'   Description:Update a single entry.  Entries MUST be verfied correct
'               before calling this routine.
'   Parameters: sConnect    ODBC Connection String. Leave blank if the
'                           Connection Object (see cn) is created outside
'                           this routine.
'               sWorksheet  Worksheet's name that contains the data
'               sData       Range's name containing the unique rows of data
'               sFields     Range's name containing field descriptions
'               sPath       Table with path (if needed) to update
'               lRow        XL row containing data to be updated/inserted
'               iACD        XL column for ACD entries (Add,Change,Delete)
'               iNotes      XL column to post error messages
'               cn          Persistent connection object.  Use for speedy
'                           updating of multiple records.
'   Example:    bResult = Update_Entry(sConnectionString, _
'                                      "Data", _
'                                      "Data", _
'                                      "Fields", _
'                                      sUpdateTable, _
'                                      lCurrentRow, _
'                                      FieldColumn("ACD","Data"),
'                                      FieldColumn("ERRORS","Data"),
'                                      cn)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler
    Update_Entry = Failure      'Assume the worse
      
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
       
    Dim lCol As Long            'Current Column
    Dim sSQL As String          'SQL string
    Dim sCRTB As String         'Carriage Return and two Tabs
    Dim bOpen As Boolean        'Was Connection open when routine called?
           
    sCRTB = vbCr & vbTab & vbTab
   
    'If the Connection wasn't created by the calling routine, make one
    bOpen = Not cn Is Nothing
    If Not bOpen Then
        If SQLConnection(cn, sConnect) = Failure Then Exit Function
    End If
   
    With Range(sData)
              
        'Check Entries. Notes should be blank and ACD should not be "X"
        If .Cells(lRow, iNotes) > "" Then Exit Function
       
        'Update Entries
        sSQL = ""
        Dim sTable As String    'Table without Path
        Dim sSlash As String    'Path seperator used
        sSlash = IIf(InStr(1, "/", sPath) > 0, "\", "/")
        sTable = Right(sPath, Len(sPath) - _
                    Chars_Last_Position(sSlash, sPath))
        Select Case UCase(.Cells(lRow, iACD))
            Case Is = "A"
                sSQL = vbCr & _
                    "Insert Into " & sPath & " " & sCRTB & "(" & _
                        Build_SQL_Insert_Fields(sFields, sTable) & _
                            ") " & vbCr & _
                    "Values (" & _
                        Build_SQL_Insert_Values(sFields, sTable, _
                            sData, lRow - 1, True) & ") "
            Case Is = "C"
                sSQL = vbCr & _
                    "Update  " & sPath & " " & vbCr & _
                    "Set     " & _
                        Build_SQL_Update_Values(sFields, sTable, _
                            sData, lRow - 1, True) & " " & vbCr & _
                    "Where   " & _
                        Build_SQL_UpdDlt_Where_Clause(sFields, sTable, _
                            sData, lRow - 1, True)
            Case Is = "D"
               sSQL = vbCr & _
                    "Delete  From " & sPath & " " & vbCr & _
                    "Where   " & _
                        Build_SQL_UpdDlt_Where_Clause(sFields, sTable, _
                            sData, lRow - 1, True)
        End Select
   
        If sSQL > "" Then
            Debug.Print sSQL
            cn.Execute sSQL
            If cn.Errors.Count = 0 Then
                .Cells(lRow, iNotes) = "Updated!"
                Update_Entry = Success          'Successful finish
                If (.Cells(lRow, iACD)) <> "D" Then _
                    .Cells(lRow, iACD) = "X"
            Else
                .Cells(lRow, iNotes) = "Errors prevented updating. " & _
                    cn.Errors(0).Description
            End If
        End If
       
    End With
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Update_Entry - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error Resume Next
    Range(sData).Cells(lRow, iNotes) = "Errors prevented updating. " & _
        cn.Errors(0).Description
    If Not bOpen Then cn.Close      'Close connection if opened here
    Settings "Restore"              'Restore application settings
    On Error GoTo 0
   
End Function

Building a Library of Routines for Updating – #4

We are just about finished with adding support routines for updating, inserting, and deleting records in a database.  As a reminder, these routines should never need modification. 

The first routine should go in modSQL.  It is used to create a connection object that can be reused.  This can greatly speed processing be eliminating constently opening and closing database connections for each insert, update, or delete.

The second routine finds the last position of a character in a string.  This is used to strip table/file names from path strings.  It can have other applications and thus, should be place in modGeneral.

Function SQLConnection(cn As ADODB.Connection, _
                       sConnect As String) As Boolean

'   Description:Create a connection to the database
'               By externalizing this, a connection can be reused

'   Parameters: cn          an ADODB connection object
'               sConnect    Connection string
'   Example:    bResult = _
                    SQLConnection(cn, _
'                       "Driver={Microsoft Access Driver (*.mdb)};" & _
'                       "DBQ=c:\Northwind.mdb")

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

    On Error GoTo ErrHandler
    SQLConnection = Failure    'Assume Something went wrong
   
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
    End If
   
    SQLConnection = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "SQLConnection - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Chars_Last_Position(sCharacter As String, _
                             sString As String) As Integer

'   Description:Returns position of last occurance of a character
'               in a string

'   Parameters: sCharacter  Character to find
'               sString     String to search for character
'   Example:    sTable = Right(sPath, len(sPath) - _
'                           Chars_Last_Position("/", sPath))

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

    On Error GoTo ErrHandler

    Dim i As Integer
   
    Chars_Last_Position = 0         'Assume not found
   
    i = 0
    Do
        i = InStr(i + 1, sString, sCharacter, vbTextCompare)
        If i > 0 Then Chars_Last_Position = i
    Loop Until i = 0
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Settings - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Building a Library of Routines for Updating – #3

You are here (click to enlarge)

This post provides “insert” functionality which adds records to tables.  The basic syntax of an SQL Insert statement is: 

INSERT INTO table_name
           (column1, column2, column3,...)
VALUES     (value1,  value2,  value3,...)

Function Build_SQL_Insert_Fields(sFields As String, sTable As String) As String

'   Description:Format field/column names for an SQL "Insert" statement
'               Use Build_SQL_Insert_Values to add associated values

'   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
'   Example:    sSQL = _
'                   "Insert Into " & sTable & " (" & _
'                    Build_SQL_Insert_Fields("Fields", sTable) & ") " & _
'                   "Values (" & _
'                    Build_SQL_Insert_Values("Fields",sTable,"Data",1,True) & ") "

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

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

    Dim lRow As Long
    Dim sSQL As String
   
    If sFields <= "" Then Exit Function
   
    sSQL = ""
    With Range(sFields)
        For lRow = 2 To .Rows.Count
            'Skip fields that are part of Primary Key or not part of update table 
            If .Cells(lRow, FieldColumn("Table", sFields)) = _
                sTable And .Cells(lRow, FieldColumn("Key", sFields)) <> "A" Then _
                    sSQL = sSQL & IIf(sSQL > "", ", ", "") & _
                       .Cells(lRow, FieldColumn("Field", sFields))
        Next lRow
    End With
   
    Build_SQL_Insert_Fields = sSQL

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

End Function

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

'   Description:Format field/column values for an SQL "Insert" statement
'               Use Build_SQL_Insert_Fields to add associated Field/Column names

'   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 = _
'                   "Insert Into " & sTable & " (" & _
'                    Build_SQL_Insert_Fields("Fields", sTable) & ") " & _
'                   "Values (" & _
'                    Build_SQL_Insert_Values("Fields",sTable,"Data",1,True) & ")"

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

    On Error GoTo ErrHandler
    Build_SQL_Insert_Values = ""    'Assume Something went wrong
   
    Dim lRow As Long
    Dim sSQL As String
    Dim sCRTB As String
    Dim sValue As String    	'Current field Value
    Dim sScreenField As String  	'Field's Screen Name

    sCRTB = vbCr & vbTab & vbTab
   
    If sFields <= "" Then Exit Function
   
    sSQL = ""
    With Range(sFields)
        For lRow = 2 To .Rows.Count
            'Skip fields not part of the table or part of an Auto ID
            If .Cells(lRow, FieldColumn("Table", sFields)) = sTable And _
                .Cells(lRow, FieldColumn("Key", sFields)) <> "A" Then
                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, "") & _
                    SQL_Add_Update_Functions(sValue, lRow, sFields)
            End If
        Next lRow
    End With
   
    Build_SQL_Insert_Values = sSQL

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

End Function

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

Building a Library of Routines for Updating – #1

You are here (Click to enlarge)

As mentioned before, we will be re-using the routines created for the reporting side. And just like we did for the reporting side of things, we need to build a library of routines before we can actually start using them to assemble applications.  This will take several posts because I use several small functions to perform specific tasks in the process (as opposed to a larger monolithic routine).  I prefer coding this way because I can test each routine more thoroughly if the code is kept simple and the functionality kept focused. 

You can get an overall view of the routines by clicking the diagram at right.

The first routine is SQL_Add_Update_Functions. This routine converts Excel formatted information into SQL friendly formats. For example, if the field in the database is character based, we need to surround the value entered in Excel with single quotes. Another example common to legacy systems is conversion of dates from Excel’s human friendly formats to system required formats, such as Julian dates (or more correctly “ordinal dates“). And on that note, to support SQL_Add_Update_Functions I have included the date format conversion routine Date2Julian and its sister Julian2Date.

By-the-way, I recommend that you create a separate module “modTableUpdate” and add SQL_Add_Update_Functions to it, along with the other routines we will add that will not require modification but are unique to spreadsheets that update databases. By having these routines in their own module, you can better manage them and include them as needed. I also recommend Date2Julian and Julian2Date be placed in “modGeneral” since they have broader applications.

Function SQL_Add_Update_Functions(sValue As String, lRow As Long, _
                                  sFields As String) As String

'   Description:Format XL data into SQL friendly formats

'   Parameters: sValue      An individual value to be posted to the database
'               lRow        Record within sFields describing field to hold sValue
'                           NOTE: This is equal to 'Field' number + 1
'               sFields     Field Definition range name
'   Example:    Debug.Print SQL_Add_Update_Functions("02/10/10", 2, "Fields")

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

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

    sValue = Replace(sValue, "'", "`")

    With Range(sFields)
        Select Case UCase(.Cells(lRow, FieldColumn("Upd.Func.", sFields)))
            Case Is = "DATE2JULIAN" 
                If IsDate(sValue) Then
                    sValue = Date2Julian(sValue)
                Else
                    sValue = "NULL"
                End If
            Case Is = "DATE"
                If IsDate(sValue) Then
                    sValue = "'" & sValue & "'"
                Else
                    sValue = "NULL"
                End If
            Case Is = "HHMMSS"
                If IsNumeric(sValue) Then
                    sValue = sValue - Int(sValue)
                    sValue = "'" & Format(sValue, "hh:mm:ss") & "'"
                Else
                    sValue = "NULL"
                End If
            Case Is = "HHMM"
                If IsNumeric(sValue) Then
                    sValue = sValue - Int(sValue)
                    sValue = "'" & Format(sValue, "hh:mm") & "'"
                Else
                    sValue = "NULL"
                End If
            Case Is = "TRIM"
                sValue = "'" & Trim(sValue) & "'"
            Case Is = "VAL"
                If IsNumeric(sValue) Then
                    sValue = Val(sValue)
                Else
                    sValue = "NULL"
                End If
            Case Else
                If .Cells(lRow, FieldColumn("Format", sFields)) > "" Then
                    sValue = "'" & _
                        Format(sValue, _
                              .Cells(lRow, FieldColumn("Format", sFields))) & "'"
                Else
                    sValue = "'" & sValue & "'"
                End If
        End Select
    End With
   
    SQL_Add_Update_Functions = sValue

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

End Function

Function Date2Julian(sDate As String) As String
   
'   Date2Julian:    Converts MM/DD/YYYY to YYYYDDD

'   Parameters:     sDate - the date to convert
'   Example:        sJulian = Date2Julian(format(now(), "mm/dd/yyyy"))

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

    On Error GoTo ErrHandler
    Date2Julian = "2000001"

    Dim dDate As Date   
    dDate = DateValue(sDate)
    Date2Julian = Year(dDate) & _
                  Format(dDate - DateValue("01/01/" & Year(dDate)) + 1, "000")
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Date2Julian - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Julian2Date(sJulian As String) As Date

'   Julian2Date:    Converts YYYYDDD to MM/DD/YYYY

'   Parameters:     sJulian - the Julian date to convert
'   Example:        dPosted = Julian2Date("2009002")

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

    On Error GoTo ErrHandler
    Julian2Date = "01/01/01"
    Julian2Date = DateValue("01/01/" & _
                  Left(sJulian, 4)) + Val(Right(Trim(sJulian), 3)) - 1
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Julian2Date - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Additions to the Fields Table for Update Spreadsheets

 As promised in the last post, here are descriptions of each column in the fields table.

Fields Table (click to enlarge)

Updating Databases from Excel – First Looks

Update Example

Normally, update spreadsheets have three buttons, “New”, “Load”, and “Post”.  I’ve trimmed this example to just two buttons for now.  We’ll add the “New” button later.

 

When the user first opens the spreadsheet, it is blank except for the buttons.  The user can click “Load” and select which products to change, or they can load all products as I have done in this example.  As followers of this blog might guess, the “Load” button acts just like our reports except for one formatting difference – the yellow cells. 

 

Yellow cells are the only cells that can be changed.  We use equivalent functionality to Excel’s “Format cell” > ”Protection” > “Locked” option, along with the ActiveSheet.Protect Contents:=True to block users from changing anything outside the yellow areas.  We also use these cell qualities to guide keyboard navigation (cursor keys) to the next open cell.

 

Another change you might have noticed is the “ACD” column.  “ACD” stands for “Add, Change, Delete”.  An “X” indicates that a record already exists in the database.  When the user changes the “Target Lvl” column, the appropriate “ACD” cell changes to “C”, indicating the record changed.  When the user clicks the ”Post” button, our spreadsheet finds rows with an “ACD” set to “C” and executes an SQL Update statement for us.  Fortunately, we can use the Fields Table to help take the drudgery out of constructing SQL statements.  Here is what the expanded “Fields Table” looks like.

 

Fields Table

Updating Databases from Excel – The Basics

Last post I encouraged readers to approach updating databases with care and professionalism. Some may wonder why then, use Excel at all if updates require the level of care in traditional programming. The answer is that Excel is a standard means for exchanging data.

As you know, the world is moving to software as a service, cloud computing, and disparate data systems. In other words, much of the data you need to run your business is, or soon will be, on the web. This data is usually in need of cleansing, transformation, denormalization, and integration with your host systems. The good news is just about every website that offers any kind of export, supports Excel, CSV, or XML formats – all of which Excel handles nicely. And by using the functionality available in Excel, you can shorten the chain of objects required to cleans and move data from website to your own server to just one object – no temporary files, no server side programs, no triggers, scheduled events, system administrator involvement – just one Excel spreadsheet.

A real world example is just now being realized in the trucking industry. The government has mandated a new means for scoring drivers and carriers. The new scoring system is called CSA-2010 and is intended to identify which drivers are likely to be involved in an accident. The new scoring system will (in my opinion) determine which drivers continue to work and which carriers continue to do business. The data for CSA-2010 comes from tens of thousands of police officers in the field from various jurisdictions who, when they pull over a trucker for a violation or at a scale, record an inspection result and upload it through a series of systems that are ultimately collected at the federal level. Carriers need this information integrated with their driver performance systems so they can take action to remediate at risk drivers and so they can improve their chances for earning business in an already cut-throat market. The problem is, with so many sources, the data often isn’t clean.

No problem. The data can be exported through XML to Excel where it is extremely easy to find inconsistencies, fix, cross check with other systems (using the data extract methods in the prior posts), and, finally, uploaded onto servers where it becomes part of the overall driver performance system.

The basic process is to read through an Excel range, pluck out values, match them to column/field names, and execute a simple SQL Insert (or Update, or even Delete) statement like:

INSERT INTO table_name (column1, column2, column3,...)
VALUES (Cell(lRow, 1), Cell(lRow, 2), Cell(lRow, 3),...)

Now constructing such Insert (or Update) statements can be tedious so as we have in the past, we will be using the “Fields” table and code to automate most of that for us.