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