SQL到Excel，然后转到CSV文件进行数据上传

Question

在我们开始之前，我需要告诉您一个关键的信息:由于离站数据库中的权限，我不允许在数据库中创建表，即使是临时的表，我也不能从数据库中获取数据。

话虽如此:下面的所有代码都按预期工作，但我想回顾一下它，因为我知道必须有一种更有效的方法来编写VBA中的SQL字符串和脚本。

过程中的步骤

1. 从Server获取数据(请注意，我只将前20行作为要测试的数据集，但最终结果将超过10,000行数据)
2. Excel VBA宏使用下面的SQL字符串获取数据
3. 将文件保存为CSV文件(此文件已经完成并工作，因此不需要处理此项目。

SQL字符串

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

下面的代码位于一个名为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

下面的代码位于一个名为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

下面的代码驻留在一个名为格式的标准模块中(我还没有给出工作表或单元格的名称)

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

我在SQL方面帮不了多少忙，但对于VBA，我建议对Dim语句进行分组，因为它最终减少了编译时间(伸缩性很好)。例如：

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

化作

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

此外，我们还可以清理最后一个格式化模块相当多。如果这变得更大，或者您的目标范围或目标表发生了更改，您将很高兴重新分解：

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

如果Set语句是整个过程中广泛使用的变量，那么我非常喜欢将它与Dim语句放在同一行，因为它显然是一个重要的语句。

其他一切看起来都很好。唯一的另一件事是，如果可以的话，我更愿意将Dim语句放在循环之外。有些人更喜欢在分配变量之前把它们放在一起，以跟踪局部变量，但我总是觉得它很混乱。在这种情况下，您使用它重置您的布尔值，这样我就可以保留它了。