清除将数据从DB2服务器传输到Excel的代码

Question

下面的代码是功能性的，可以按照预期工作，但是我想有更好的方法来测试我正在测试的错误。

这种情况是数据在两台不同的服务器之间全年传输，因此我构建了一个错误处理程序，检查到该服务器的连接是否有效；如果连接无效，则转到错误处理程序。我正在寻求对这段代码的审查，以简化它，并希望能够更有效地处理它。

代码：

Option Explicit
Sub CIFIncoming()
    Dim adoConn As New ADODB.Connection
    Dim cfRS As New ADODB.Recordset
    Dim Name As String, Address1 As String, Address2 As String
    Dim City As String, State As String, Zip As String
    Dim HomePhone As String, CellPhone As String
    Dim BSA As String
    Dim strConn As String
    Dim CIFstr As String, CIF As String

    On Error GoTo ErrHandler

'\\\\BEGIN DATABASE INFORMATION GRAB////
'   1.  Sets the Connection String to the Data Base
'   2.  Opens the connection to the database
'   3.  Sets the SQL String to get the fields from the Data Base
'   4.  Defines the CIF Number to use in the SQL String
'   5.  Opens the Recordset
'   6.  Checks to see where the cursor in the DataBase is and runs the code based on that conditon
'       BOF = Begining of File
'       EOF = End of File

    strConn = REDACTED

    adoConn.Open strConn

    CIF = UCase(Sheet1.Range("B103").Text)

    CIFstr = "SELECT " & _
             "cfna1, cfna2, cfna3, cfcity, cfstat, LEFT(cfzip, 5), cfhpho, cfcel1, cfudsc6 " & _
             "FROM cncttp08.jhadat842.cfmast cfmast " & _
             "WHERE cfcif# = '" & CIF & "'"

    cfRS.Open CIFstr, adoConn

    If Not (cfRS.BOF And cfRS.EOF) Then

'\\\\END DATABASE INFORMATION GRAB////

'\\\\BEGIN WORKSHEET INFORMATION PLACEMENT////
'   1.  Assigns each field from the Database to a variable
'   2.  Moves data from Database to specific cells

        Name = Trim(cfRS(0))     'cfna1
        Address1 = Trim(cfRS(1)) 'cfna2
        Address2 = cfRS(2)       'cfna3
        City = Trim(cfRS(3))     'cfcity
        State = Trim(cfRS(4))    'cfstat
        Zip = cfRS(5)            'cfzip
        HomePhone = cfRS(6)      'cfhpho
        CellPhone = cfRS(7)      'cfcel1
        BSA = cfRS(8)            'cfudsc6

        With Sheet1
            .Range("B104") = Name
            .Range("B105") = Address1
            .Range("B106") = Address2
            .Range("B107") = City & ", " & State & " " & Zip
        End With

    End If

    If Sheet1.Range("B103") = vbNullString Then
        With Sheet1
            .Range("B104") = vbNullString
            .Range("B105") = vbNullString
            .Range("B106") = vbNullString
            .Range("B107") = vbNullString
        End With
    End If

'\\\\END WORKSHEET INFORMATION PLACEMENT////

'\\\\BEGIN FINAL DATABASE OPERATIONS////
'   1.  Closes connection to Database
'   2.  Sets the Recordset from the Database to Nothing
'   3.  Exits sub when there are no errors

    cfRS.Close
    Set cfRS = Nothing
    Exit Sub
'\\\\END FINAL DATABASE OPERATIONS

ErrHandler:
    If Err.Number = -2147467259 Then GoTo Branson

Branson:
    CIF = UCase(Sheet1.Range("B103").Text)

    CIFstr = "SELECT " & _
             "cfna1, cfna2, cfna3, cfcity, cfstat, LEFT(cfzip, 5), cfhpho, cfcel1, cfudsc6 " & _
             "FROM bhschlp8.jhadat842.cfmast cfmast " & _
             "WHERE cfcif# = '" & CIF & "'"

    cfRS.Open CIFstr, adoConn

    If Not (cfRS.BOF And cfRS.EOF) Then

'\\\\END DATABASE INFORMATION GRAB////

'\\\\BEGIN WORKSHEET INFORMATION PLACEMENT////
'   1.  Assigns each field from the Database to a variable
'   2.  Moves data from Database to specific cells

        Name = Trim(cfRS(0))     'cfna1
        Address1 = Trim(cfRS(1)) 'cfna2
        Address2 = cfRS(2)       'cfna3
        City = Trim(cfRS(3))     'cfcity
        State = Trim(cfRS(4))    'cfstat
        Zip = cfRS(5)            'cfzip
        HomePhone = cfRS(6)      'cfhpho
        CellPhone = cfRS(7)      'cfcel1
        BSA = cfRS(8)            'cfudsc6

        With Sheet1
            .Range("B104") = Name
            .Range("B105") = Address1
            .Range("B106") = Address2
            .Range("B107") = City & ", " & State & " " & Zip
        End With

    End If

    If Sheet1.Range("B103") = vbNullString Then
        With Sheet1
            .Range("B104") = vbNullString
            .Range("B105") = vbNullString
            .Range("B106") = vbNullString
            .Range("B107") = vbNullString
        End With
    End If

'\\\\END WORKSHEET INFORMATION PLACEMENT////

'\\\\BEGIN FINAL DATABASE OPERATIONS////
'   1.  Closes connection to Database
'   2.  Sets the Recordset from the Database to Nothing
'   3.  Exits sub when there are no errors

    cfRS.Close
    Set cfRS = Nothing
    Exit Sub
'\\\\END FINAL DATABASE OPERATIONS

End Sub

Answer 1

编写、调试和修改执行1或2个操作的较小代码块要容易得多。因此，应该将代码分离为多个子类和函数。我还建议利用字段别名为您的字段提供更有意义的名称。

重构代码

Option Explicit
Const REDACTED = "<Connection String>"

Private Type DBGrabRecord
    Name As String
    Address1 As String
    Address2 As String
    City As String
    State As String
    Zip As String
    HomePhone As String
    CellPhone As String
    BSA As String
    TableName As String
    ErrNumber As Long
End Type


Sub CIFIncoming()
    Const bhschlp8 As String = "bhschlp8.jhadat842.cfmast cfmast"
    Const cncttp08 As String = "cncttp08.jhadat842.cfmast cfmast"
    Const ConnectionError As Long = -2147467259

    Dim CIF As String
    Dim tDBGrabRecord As DBGrabRecord

    CIF = Sheet1.Range("B103").Text

    If Not CIF = vbNullString Then
        tDBGrabRecord = getDBGrabTestRecord(bhschlp8, CIF)
        If tDBGrabRecord.ErrNumber = ConnectionError Then tDBGrabRecord = getDBGrabTestRecord(cncttp08, CIF)
    End If

    With Sheet1
        .Range("B104") = tDBGrabRecord.Name
        .Range("B105") = tDBGrabRecord.Address1
        .Range("B106") = tDBGrabRecord.Address2
        .Range("B107") = tDBGrabRecord.City & ", " & tDBGrabRecord.State & " " & tDBGrabRecord.Zip
    End With

    Debug.Print "Table Name: "; tDBGrabRecord.TableName

End Sub

Private Function getDBGrabTestRecord(ByVal TableName As String, ByVal CIF As String) As DBGrabRecord
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim SQL As String
    Dim tDBGrabRecord As DBGrabRecord

    On Error Resume Next

    conn.Open REDACTED

    SQL = getDBGrabSQL(TableName, CIF)

    rs.Open CIFstr, conn

    If Not (rs.BOF And rs.EOF) Then
        With tDBGrabRecord
            .Name = Trim(rs.Fields("Name").Value)
            .Address1 = Trim(rs.Fields("Address1").Value)
            .Address2 = Trim(rs.Fields("Address2").Value)
            .City = Trim(rs.Fields("City").Value)
            .State = Trim(rs.Fields("State").Value)
            .Zip = Trim(rs.Fields("Zip").Value)
            .HomePhone = Trim(rs.Fields("HomePhone").Value)
            .CellPhone = Trim(rs.Fields("CellPhone").Value)
            .BSA = Trim(rs.Fields("BSA").Value)
            .TableName = TableName
        End With
    End If

    rs.Close
    conn.Close

    tDBGrabRecord.ErrNumber = Err.Number

    getDBGrabTestRecord = tDBGrabRecord
End Function

Private Function getDBGrabSQL(ByVal TableName As String, ByVal CIF As String) As String
    Dim SelectClause As String
    Dim FromClause As String
    Dim WhereClause As String

    SelectClause = "SELECT cfna1 AS Name, cfna2 AS Address1, cfna3 AS Address2, cfcity AS City, cfstat AS State, LEFT(cfzip, 5) AS Zip, cfhpho AS HomePhone, cfcel1 AS CellPhone, cfudsc6 AS BSA"
    FromClause = "FROM " & TableName
    WhereClause = "WHERE cfcif# = '" & UCase(CIF) & "'"

    getDBGrabSQL = SelectClause & vbNewLine & FromClause & vbNewLine & WhereClause
End Function