Apr 15 2010 8:10AM GMT

Building a Library of Routines for Updating – #1

Craig Hatmaker Profile: Craig Hatmaker

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