Filling Out Large Number of Fields Efficiently in SQL/VBA

Question

I'm working with a table with a large number of fields (40+) in which each record has some fields that need to be filled with "custom" data (based on the results of the program) and the rest need the same "default" values entered repeatedly. I'm writing this program in VBA through MS access.

The actual syntax of creating a new record with field entries is not a problem, but I'm not sure of the best way to enter the most efficient/readable code for all these default entries. Since there's no way to refer to SQL fields using only the column location, I'm thinking the code will quickly turn ugly when referring to each field by a human readable name.

My current code is

 DoCmd.RunSQL "INSERT INTO Table1 ([PartNumber],[Description],[Alternate],[Supplier],[Location],[Rev]) values('" & PartNumber & "','" & Description & "'," _
                                & " '" & Alt & "', '" & Supplier & "', '" & Location & "','" & Rev & "')"

So this is going to get ugly with 35+ more values.

Create variables with the proper value for each field first. Use those variables in your insert query. Use query parameters. — Dan Bracuk, Oct 18 '16 at 16:24
What do you mean by "Query Parameters"? The variables in the insert query at already set prior to executing the code above, its just the inserting of variables into fields that seems ugly to me. — user2059972, Oct 18 '16 at 16:50

Vityata · Answer 1 · 2018-07-12T12:34:48.443

I was also looking for an answer of a similar problem, knowing that inserting like your example is really a crazy (and ugly) idea. What I came up with was something like this:

Option Explicit

Public Sub GenerateDataIntoTable()

    Dim str_table_name      As String: str_table_name = "Main"
    Dim arr_column_names    As Variant
    Dim arr_values          As Variant

    ReDim arr_column_names(6)
    ReDim arr_values(6)

    arr_column_names(0) = "UserName"
    arr_column_names(1) = "CurrentDate"
    arr_column_names(2) = "CurrentTime"
    arr_column_names(3) = "CurrentLocation"
    arr_column_names(4) = "Status1"
    arr_column_names(5) = "Status2"
    arr_column_names(6) = "Status3"

    arr_values(0) = Environ("username")
    arr_values(1) = Date
    arr_values(2) = Time
    arr_values(3) = Application.ActiveWorkbook.FullName
    arr_values(4) = 2
    arr_values(5) = arr_values(4) + 4
    arr_values(6) = arr_values(5) - 4

    Debug.Print b_insert_into_table(str_table_name, arr_column_names, arr_values)

End Sub

Function b_insert_into_table(str_table_name As String, arr_column_names As Variant, arr_values As Variant) As Boolean

    Dim conn            As Object
    Dim str_order       As String

    Set conn = CreateObject("ADODB.Connection")
    'conn.Open str_connection_string

    str_order = "insert into dbo." & str_table_name
    str_order = str_order & str_generate_order(arr_column_names, arr_values)
    Debug.Print str_order
    'conn.Execute str_order
    'conn.Close
    Set conn = Nothing

    b_insert_into_table = True

End Function

Public Function str_generate_order(arr_column_names As Variant, arr_values As Variant) As String

    Dim l_counter       As Long
    Dim str_result      As String

    Dim str_left        As String: str_left = "('"
    Dim str_midd        As String: str_midd = "','"
    Dim str_right       As String: str_right = "')"

    str_result = "("
    For l_counter = LBound(arr_column_names) To UBound(arr_column_names)
        str_result = str_result & arr_column_names(l_counter) & ","
    Next l_counter

    str_result = Left(str_result, Len(str_result) - 1)
    str_result = str_result & ")"
    str_result = str_result & "values"

    str_result = str_result & str_left
    For l_counter = LBound(arr_values) To UBound(arr_values)
        str_result = str_result & arr_values(l_counter)

        If l_counter < UBound(arr_values) Then
            str_result = str_result & str_midd
        Else
            str_result = str_result & str_right
        End If

    Next l_counter

    str_generate_order = str_result

End Function

In order to run it, run the GenerateDataIntoTable(). If you want to run it in an application, uncomment the comments in b_insert_into_table and set something meaningful for the str_connection_string.

score 0 · Answer 2 · edited May 23 '17 at 12:24

Consider a parameterized query which is a programming industry best practice across all RDMS's where you prepare an initial SQL statement and then bind values to declared parameters according to their data types. In this way you avoid enclosing each value with needed quotes and can even iterate without re-assigning query statement. And most importantly, you overcome sql injection as malicious users can run SQL queries through user input and cause serious harm to data and/or schema.

In MS Access SQL, you can use the PARAMETERS clause to define named parameters. Then in VBA, you can assign values to each. Also with a saved query, processing is more efficient as your query is optimized by the engine versus a VBA string query processed as a new query during runtime.

SQL (save below as a stored query; add all 40 fields)

PARAMETERS partparam INTEGER, descparam TEXT(255), altparam TEXT(255),
           supplierparam TEXT(255), locationparam TEXT(255), revparam TEXT(255);
INSERT INTO Table1 ([PartNumber],[Description],[Alternate], [Supplier],[Location],[Rev])
VALUES(partparam, descparam, altparam, supplierparam, locationparam, revparam);

VBA (reference stored querydef and bind values to corresponding named params)

Dim db as Database
Dim qdef as Querydef

Set db = CurrentDb    
Set qdef = db.QueryDefs("SavedQueryName")

qdef!partparam = 9999
qdef!descparam = "Some description"
qdef!altparam = "Some alternate"
qdef!supplierparam = "Some supplier"
qdef!locationparam = "Some location"
qdef!revparam = "Some rev"

qdef.Execute dbFailOnError

Set qdef = Nothing
Set db = Nothing

score 0 · Answer 3 · answered Nov 02 '16 at 21:06

Do it like Parfait suggested. That's infinitely easier to maintain, debug, etc. Also, see the sample below.

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

http://www.erlandsendata.no/english/index.php?d=envbadacexportado

OR . . .

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

http://www.erlandsendata.no/english/index.php?d=envbadacexportdao

Filling Out Large Number of Fields Efficiently in SQL/VBA

3 Answers3