使用 Excel VBA 插入 Redshift

Question

I have a requirement to load data from excel to Redshift. I am getting errors because there are numeric columns and the conversion of the values in each cell of a row into an array is then becoming a string. This is fine, except for the numeric columns which need a Null and not ''.

Here is the code.

Private Sub CommandButton1_Click()
Dim BCS As Worksheet

Set BCS = ThisWorkbook.Sheets(Sheet3.Name)
Sheetcolumns = "(fbn,region,site,finance_manager,phase_type,number_of_stories,phase_count,scenario_design_type," & _
               "op_build_schedule_handoff,weeks_until_handoff,standard_tke,car_total,qty_subcategory,value_subcategory," & _
               "po_qty,po_unit_cost,po_total,invoice_qty,invoice_unit_cost,invoice_total,percent_diff_invoice_v_po," & _
               "manual_qty_est,manual_unit_cost_est,manual_adj_est,manual_est_total,est_choice,final_est_qty,final_unit_cost_est," & _
               "final_adj_est,final_est_total,forecast_reduction_choice,forecast_reduction_percent,final_forecast," & _
               "po_v_manual_percent_diff,inv_v_manual_percent_diff,notes,snapshot_date)"
Set con = New ADODB.Connection

#If Mac Then
    'if Mac then use this driver
    CS = "Driver={Amazon Redshift};SERVER={<Redshift>};UID=<user>;PASSWORD=<ped>;DATABASE=<db>;PORT=8192"
#ElseIf Win64 Then
    CS64 = "Driver={Amazon Redshift (x64)};SERVER={<Redshift>};UID=<user>;PASSWORD=<password>;DATABASE=awscfpa;PORT=8192"
    con.Open CS64
#Else
    CS32 = "Driver={Amazon Redshift (x86)};SERVER={<Redshift>};UID=<user>;PASSWORD=<ped>;DATABASE=awscfpa;PORT=8192"
    con.Open CS32
#End If

For r = 2 To BCS.ListObjects(1).DataBodyRange.Rows.Count
    valuesArray = BCS.Range("A" & r & ":AJ" & r).Value
    insertValues = Join2D(valuesArray, "','")

    Sql = "INSERT INTO dcgs.bcs_output " & Sheetcolumns & "VALUES(" & "'" & insertValues & "'" & ",CURRENT_DATE)"
    con.Execute Sql
Next r

con.Close
Set con = Nothing



End Sub
Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String

    Dim i As Long, j As Long
    Dim aReturn() As String
    Dim aLine() As String

    ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1))
    ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2))

    For i = LBound(vArray, 1) To UBound(vArray, 1)
        For j = LBound(vArray, 2) To UBound(vArray, 2)
            'Put the current line into a 1d array
            aLine(j) = vArray(i, j)
        Next j
        'Join the current line into a 1d array
        aReturn(i) = Join(aLine, sWordDelim)
    Next i

    Join2D = Join(aReturn, sLineDelim)

End Function

Join2D is something I had from a previous ask, but in that case everything was a string. Is there a way to modify this to give an output where if the insertValues element is '' it changes it to Null? I tried a for loop with an if statement to try and change any element that is '' to Null and it gave a type mismatch.

I am also open to other ways to get the data to Redshift which don't require row by row insertion if that is an easier option.

Answer 1

Consider the industry best practice of SQL parameterization to avoid the messy and potentially dangerous need to concatenate and punctuate data values into SQL statements. And also avoid combining disparate data types with array methods.

Assuming your Excel database API is ADO, consider the Command object for parameterization. This requires you to extend .CreateParameter() calls for all 36 fields (A-AJ columns) and explicitly define data types. Empty cells may translate as NULL entities for insertion.

' PREPARED STATEMENT (NO DATA) WITH 36 PARAM PLACEDHOLERS
sql = "INSERT INTO dcgs.bcs_output (Col1, Col2, Col3, ..., Col37) " _
          & " VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?,                   " _ 
          & "        ?, ?, ?, ?, ?, ?, ?, ?, ?,                   " _
          & "        ?, ?, ?, ?, ?, ?, ?, ?, ?,                   " _
          & "        ?, ?, ?, ?, ?, ?, ?, ?, ?, CURRENT_DATE)     "             

For r = 2 To BCS.ListObjects(1).DataBodyRange.Rows.Count
    ' CONFIGURE ADO COMMAND
    Set cmd = New ADODB.Command

    With cmd
        .ActiveConnection = conn
        .CommandText = sql
        .CommandType = adCmdText

        ' BIND ALL 36 PARAM VALUES
        .Parameters.Append .CreateParameter("param1", adInt, adParamInput, , BCS.Range("A" & r).Value)
        .Parameters.Append .CreateParameter("param2", adVarchar, adParamInput, , BCS.Range("B" & r).Value)
        ' ...
        .Parameters.Append .CreateParameter("param36", adXXXX, adParamInput, , BCS.Range("AJ" & r).Value)

        ' EXECUTE ACTION
        .Execute
    End With

    Set cmd = Nothing
Next r