Beyond Excel: VBA and Database Manipulation

Apr 28 2010   4:15PM GMT

Building a Library of Routines for Updating – #3

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

You are here (click to enlarge)

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,...)
To build this statement, we have two routines.  One creates a string of column/field names and the other creates a string of values.  The column/field names come from the Fields Defnition table.  The values come from the end user’s entries in the “Data” range.
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
 

 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: