Question

我有9张表连接到teradata中的不同表，每次我都要输入我的用户名和密码来刷新并获取新的数据集。有人可以建议我如何编写一个VBA代码，可以更改每个连接的连接字符串并刷新数据表。我是VBA的初学者，并且没有在VBA编码的线索

由于 SYAM

Answer 1

这就是我所做的：我将以下内容放在A2：B5单元格中数据源：数据库：

我把SQL放在单元格D2中。我使用第1行告诉我查询需要多长时间。然后，我在页面的任何位置添加一个按钮。然后我调用下面的代码。它看起来很复杂，但功能的核心都在Get_Data_Teradata中。

Get_SQL函数只是读取D列，直到找到一个空行，然后返回SQL的大块文本。您可以使用硬编码的SQL语句替换它。

Pop_Col_Heads将结果中的列标题放在第1行中。注意，我在Win 7上的Excel 2010中发现了一个Bug，我只能在每个Excel会话中填充一次或两次列。如果我再次退出并加载Excel，则会再次运行一次或两次。

Copy_Data_From_RDBMS将ADODB RecordSet放置在活动工作表中的范围内。我不得不做一些调整来处理插入和更新，因为它们不会返回任何行。

Sub Get_Data_Teradata()
'Supports Multi Query
Dim cn As ADODB.Connection
    Dim sConnect As String
    Set cn = New ADODB.Connection
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim cmdSQLData As ADODB.Command
    Set cmdSQLData = New ADODB.Command
    Dim sQueries() As String

    sConnect = "Persist Security Info=True; Session Mode=ANSI; " & _
               "Data Source=" & ActiveSheet.Range("B2").Value & ";" & _
               "Database=" & ActiveSheet.Range("B3").Value & ";" & _
               "User ID=" & ActiveSheet.Range("B4").Value & ";" & _
               "Password=" & ActiveSheet.Range("B5").Value & ";"
    sQueries = Get_SQL(ActiveSheet.Range("D2:D9999"))
    nRow = 1 'initialize to start at the top of the page
    For i = 0 To UBound(sQueries) - 1
        cn.Open sConnect
        Set cmdSQLData.ActiveConnection = cn
        cmdSQLData.CommandText = sQueries(i) 'TELL VBA TO LOAD THE QUERY INTO TERADATA
        cmdSQLData.CommandType = adCmdText
        cmdSQLData.CommandTimeout = 0
        Set rs = cmdSQLData.Execute()
        Call Pop_Col_Heads(rs, nRow)
        nRow = Copy_Data_From_RDBMS(rs, nRow)
        cn.Close
    Next i
End Sub

Dim a As Long
Dim i As Long
Dim nIndex As Long
Dim sSQL() As String


Function Get_SQL(oRange As Object) As String()
'First figure out how many rows the SQL statement is
a = 0
    For Each cCell In oRange
        a = a + 1
        If cCell.Value = "" Then
            a = a - 1
            Exit For
        End If
    Next cCell

'Num rows = a now
'Step through and parse into array
    i = 0
    nIndex = 0
    ReDim Preserve sSQL(1)
    For Each cCell In oRange
        i = i + 1
        If i > a Then
            Exit For
        ElseIf cCell.Value = "<Multi>" Then
            nIndex = nIndex + 1
            ReDim Preserve sSQL(nIndex + 1)
        Else
            sSQL(nIndex) = sSQL(nIndex) & To_Text(cCell.Value) & " "
        End If
    Next cCell
    Get_SQL = sSQL
End Function

Sub Pop_Col_Heads(rs As Object, nRow As Long)
    Dim rHeads As Range
    Dim fFields As Field
    Dim nCol As Integer

    nCol = 0
    If nRow = 1 Then
        ActiveSheet.Range("E1:ZZ1").ClearContents
    End If
    Set rHeads = ActiveSheet.Range("E1").Offset(nRow - 1, 0)
    Do While nCol < rs.Fields.Count
        sTemp = rs.Fields(nCol).Name
        rHeads.Cells(nRow, nCol + 1).Value = rs.Fields(nCol).Name
        ActiveSheet.Calculate
        rHeads.Cells(nRow, nCol + 1).Value = sTemp
        nCol = nCol + 1
        rHeads.WrapText = True
        rHeads.VerticalAlignment = xlVAlignTop
    Loop
End Sub

Function Copy_Data_From_RDBMS(rs As Object, nRow As Long) As Long
'Supports Multi Query
    If nRow = 1 Then
        x = Get_Last_Row_Find(ActiveSheet.Range("E1:ZZ64000"))
        ActiveSheet.Range("E2:ZZ" & x).ClearContents
    End If
    On Error Resume Next
    rs.MoveFirst
    On Error GoTo 0
    If Not rs.EOF Then
        ActiveSheet.Range("E2").Offset(nRow - 1, 0).CopyFromRecordset rs
        x = Get_Last_Row_Find(ActiveSheet.Range("E1:ZZ64000"))
        Copy_Data_From_RDBMS = x + 1
        ActiveSheet.Range("E2:ZZ" & x).Offset(nRow - 1, 0).WrapText = False
    Else 'no results (e.g. insert)
        ActiveSheet.Range("E2").Offset(nRow - 1, 0).Value = "<no data returned>"
    End If
    rs.Close
    Set rs = Nothing
End Function

通过代码更改连接字符串

1 个答案: