SQL to Excel then to CSV file for Data Upload

Question

Before we get started I need to let you know a critical piece of information: Due to permissions within an offsite database I am NOT allowed to create tables even temporary ones within the database that I am getting the data from.

With that being said: All of the code below works as expected, but I would like a review of it because I know that there has to be a more efficient way of writing both the SQL String and the script within VBA.

Steps in the process

1. Get Data from a SQL Server (please note that I am only getting the first 20 rows as a data set to test, but the final result will be well over 10,000 rows of data)
2. Excel VBA Macros to grab data with the below SQL String
3. Save File as a CSV file (This is already completed and working, so no need to address this item.

SQL String

SELECT cfcif# AS "Customer Number",
                 cffna AS "First Name",
                 cfmna AS "Middle Name",
                 COALESCE(
                    NULLIF(cflna,''),cfna1) AS "Last Name",                
                 COALESCE(
                    NULLIF(
                        RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))) AS "Street Address",
                 COALESCE(
                    NULLIF(cfpfcy,''),cfcity) AS "Street City",
                 COALESCE(
                    NULLIF(cfpfst,''),cfstat) AS "Street State",
                 COALESCE(
                    NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5)) AS "Street Zip",
                 RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)) AS "Mailing Address",
                 cfcity AS "Mailing City",
                 cfstat AS "Mailing State",
                 LEFT(cfzip, 5) AS "Mailing Zip",
                 NULLIF(cfhpho,0) AS "Home Phone",
                 NULLIF(cfbpho,0) AS "Business Phone",
                 NULLIF(cfssno,0) AS "TIN",
                 (CASE 
                    WHEN cfindi = 'Y' THEN '1'
                    WHEN cfindi = 'N' THEN '2'
                   END)
                  AS "Customer Type",
                 (CASE
                    WHEN cfdob7 = 0 THEN NULL
                    WHEN cfdob7 = 1800001 THEN NULL
                    ELSE cfdob7
                  END) AS "Date of Birth",
                 cfeml1 AS "Email Address"
    FROM bhschlp8.jhadat842.cfmast cfmast
    WHERE cfdead = 'N'
    ORDER BY cfcif#
    FETCH FIRST 20 ROWS ONLY

EXCEL

Private Sub Workbook_Open()
    GetData
End Sub

The below Code is in a Standard Module called ConstVars

Option Explicit
Public Const BRANSONSERVER As String = "bhschlp8.jhadat842.cfmast cfmast"
Public Const CHARLOTTESERVER As String = "cncttp08.jhadat842.cfmast cfmast"
Public Const CONNECTIONERROR As Long = -2147467259
Public Const CONNECTIONSTRING As String = Redacted for public viewing

The below code resides in a Standard Module called CiF

Option Explicit
Sub GetData()

    AddHeaders
    getDBGrabTestRecord (Array(BRANSONSERVER, CHARLOTTESERVER))
    Sheet1.Cells.EntireColumn.AutoFit

End Sub
Private Function getDBGrabTestRecord(arrNames)
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")

    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")

    Dim nm

    conn.Open CONNECTIONSTRING

    For Each nm In arrNames
        Dim SQL As String

        SQL = getDBGrabSQL(CStr(nm))

        On Error Resume Next
        rs.Open SQL, conn
        Dim okSQL As Boolean
        If Err.Number = 0 Then okSQL = True
        On Error GoTo 0
        If okSQL Then
            If Not rs.EOF Then
                Sheet1.Range("A2").CopyFromRecordset rs
            End If
            Exit For
        End If
    Next nm

End Function
Private Function getCIFDBGrabTestRecord(arrNames)


    Dim SQL As String

    On Error Resume Next

    conn.Open CONNECTIONSTRING

    SQL = getDBGrabSQL(TableName)

    rs.Open SQL, conn

    tDBGrabRecord.ErrNumber = Err.Number

    If Not (rs.BOF And rs.EOF) Then
        rs.MoveFirst
        Sheet1.Range("A2").CopyFromRecordset rs
    End If

    rs.Close
    conn.Close

End Function
Private Function getDBGrabSQL(ByVal TableName As String) As String
    Dim SelectClause As String
    Dim FromClause As String
    Dim WhereClause As String
    Dim OrderClause As String
    Dim FetchClause As String

    SelectClause = GetSelectClause

    FromClause = "FROM " & TableName
    WhereClause = "WHERE cfdead = " & "'" & "N" & "'"
    OrderClause = "ORDER BY cfcif#"
    FetchClause = "FETCH FIRST 20 ROWS ONLY"

    getDBGrabSQL = SelectClause & vbNewLine & FromClause & vbNewLine & WhereClause & vbNewLine & OrderClause & vbNewLine & FetchClause

    Debug.Print getDBGrabSQL

End Function
Private Function GetSelectClause() As String
    Const Delimiter As String = vbNewLine
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    With list
        .Add "SELECT cfcif#,"
        .Add "cffna,"
        .Add "cfmna,"
        .Add "COALESCE("
        .Add "NULLIF(cflna,''),cfna1),"
        .Add "COALESCE("
        .Add "NULLIF("
        .Add "RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))),"
        .Add "COALESCE("
        .Add "NULLIF(cfpfcy,''),cfcity),"
        .Add "COALESCE("
        .Add "NULLIF(cfpfst,''),cfstat),"
        .Add "COALESCE("
        .Add "NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5)),"
        .Add "RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)),"
        .Add "cfcity,"
        .Add "cfstat,"
        .Add "LEFT(cfzip, 5),"
        .Add "NULLIF(cfhpho,0),"
        .Add "NULLIF(cfbpho,0),"
        .Add "NULLIF(cfssno,0),"
        .Add "(CASE"
        .Add "WHEN cfindi = 'Y' THEN '1'"
        .Add "WHEN cfindi = 'N' THEN '2'"
        .Add "END),"
        .Add "(CASE"
        .Add "WHEN cfdob7 = 0 THEN NULL"
        .Add "WHEN cfdob7 = 1800001 THEN NULL"
        .Add "ELSE cfdob7"
        .Add "END),"
        .Add "cfeml1"

    End With

    GetSelectClause = Join(list.ToArray, Delimiter)

End Function

The below code resides in a Standard Module called Formatting(I havent given the Sheet or Cells names yet)

Option Explicit
Public Sub AddHeaders()

    Sheet1.Range("A1") = "Customer Number"
    Sheet1.Range("B1") = "First Name"
    Sheet1.Range("C1") = "Middle Name"
    Sheet1.Range("D1") = "Last Name"
    Sheet1.Range("E1") = "Street Address"
    Sheet1.Range("F1") = "Street City"
    Sheet1.Range("G1") = "Street State"
    Sheet1.Range("H1") = "Street Zip"
    Sheet1.Range("I1") = "Mailing Address"
    Sheet1.Range("J1") = "Mailing City"
    Sheet1.Range("K1") = "Mailing State"
    Sheet1.Range("L1") = "Mailing Zip"
    Sheet1.Range("M1") = "Home Phone"
    Sheet1.Range("N1") = "Work Phone"
    Sheet1.Range("O1") = "TIN"
    Sheet1.Range("P1") = "Customer Type"
    Sheet1.Range("Q1") = "Date of Birth"
    Sheet1.Range("R1") = "Email Address"

End Sub

Answer 1

I can't be much help on the SQL front, but for VBA, I would recommend grouping your Dim statements, as it ultimately reduces compile time (scales well). For instance:

    Dim SelectClause As String
    Dim FromClause As String
    Dim WhereClause As String
    Dim OrderClause As String
    Dim FetchClause As String

Becomes

Dim SelectClause as String, FromClause As String, WhereClause As String, _
    OrderClause As String, FetchClause As String

Also, we can clean up this last Formatting module quite a bit. If this gets any bigger or either your destination range or your destination sheet changes, you'll be glad you refactored:

Public Sub AddHeaders()
Dim mySheet as Worksheet: Set mySheet = Sheet1

Dim labelText as Variant

'I'm putting linebreaks so that they are grouped nicely
labelText = Array("Customer Number", "First Name", "Middle Name", "Last Name", _
    "Street Address", "Street City", "Street State", "Street Zip", _
    "Mailing Address", "Mailing City", "Mailing State", "Mailing Zip", _
    "Home Phone", "Work Phone", _
    "TIN", "Customer Type", "Date of Birth", _
    "Email Address")

For i = 1 to UBound(labelText)
    mySheet.Cells(i, 1).Value = labelText(i)
Next i

End Sub

I'm a big fan of putting Set statements on the same line as Dim statements if it's a widely used variable throughout the procedure, as it is clearly an important statement.

Everything else looks good. Only other thing is that I prefer to put Dim statements outside of the loops if I can. Some people prefer putting them before assigning the variable, to keep track of local variables, but I always feel like it clutters loops. In this instance, you're using it to reset your Boolean so I'd leave it.