将SQL转换为VBA字符串的函数

时间:2014-04-03 14:11:50

标签: sql excel vba excel-vba

我在Excel工作表中构建了数百个SQL查询,每个查询都放在一列的单元格中。我想要做的是从excel运行这些SQL语句。

只是想知道是否有人知道将我的所有SQL转换为VBA字符串的方法,我可以遍历所有行来运行每个查询。

我发现这是我想要做的,但有没有办法可以改变代码,以便它可以读取excel单元而不是表单?

http://allenbrowne.com/ser-71.html

由于

编辑:这是我想要转换的示例SQL

SELECT 
TT.TEST_TABLE_ID,
TT.TEST_TABLE_NO,
TT.MEMBERSHIP_NUMBER,
TT.TEST_TABLE_TYPE,
from TEST_TABLE TT

我认为因为每个Select都在它自己的行中,所以当它转换时会导致问题。

编辑#2:这是我执行SQL的代码

Sub GetData()
Dim Conn As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim sqlText As String
Dim Row As Long
Dim Findex As Long
Dim Data As Worksheet
Dim X As Long
    Set Data = Sheets("Results")
    Data.Select
    Cells.ClearContents
    Conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
    cmd.ActiveConnection = Conn
    cmd.CommandType = adCmdText
    'sqlText = How to reference Valid SQL cells
    cmd.CommandText = sqlText
    Set RS = cmd.Execute
    For X = 1 To RS.Fields.Count
        Data.Cells(1, X) = RS.Fields(X - 1).Name
    Next

    If RS.RecordCount < Rows.Count Then
        Data.Range("A2").CopyFromRecordset RS
    Else
        Do While Not RS.EOF
           Row = Row + 1
           For Findex = 0 To RS.Fields.Count - 1
             If Row >= Rows.Count - 50 Then
                Exit For
             End If
             Data.Cells(Row + 1, Findex + 1) = RS.Fields(Findex).Value
           Next Findex
           RS.MoveNext
        Loop
    End If
    Cells.EntireColumn.AutoFit
End Sub

在SQL文本部分中,我希望能够引用我的SQL语句列。我以为我需要转换它但你们是对的,如果引用它我可以使用你的代码Brad。

我试图将你的代码brad合并到我的'sqlText =如何引用有效SQL单元但是没有成功

3 个答案:

答案 0 :(得分:2)

这是我认为你需要的代码的开始。

我已将SQL放在名为&#34; SQL&#34;,在Col A中的工作表中。 这个问题是: (1)您将字段名称放在一行中,然后将数据放入一行中。这将需要每个SQL语句两行。 (2)我从sheet&#34; SQL&#39;中复制了SQL语句。并放置在&#34;结果&#34;的Col A中; (你提到你想把结果放在SQL字符串的右边。(3)你清除&#34;结果&#34;表的内容,所以如果你决定组合表,你需要注意不要删除你的SQL。

Option Explicit

Sub Process_SQL_Strings()
Dim cmd         As New ADODB.Command
Dim sqlText     As String
Dim Row         As Long
Dim Findex      As Long
Dim Data        As Worksheet
Dim iFldCt      As Long
Dim conn        As ADODB.Connection
Dim rs          As ADODB.Recordset
Dim sConn       As String
Dim lLastRow    As Long
Dim lRow        As Long

    Set Data = Sheets("Results")
    Data.Select
    Cells.ClearContents
    conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
    cmd.ActiveConnection = conn
    cmd.CommandType = adCmdText

''        Set conn = New ADODB.Connection
''        sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
''                                 "Data Source=C:\data\access\tek_tips.accdb;" & _
''                                 "Jet OLEDB:Engine Type=5;" & _
''                                 "Persist Security Info=False;"
    conn.Open sConn

    'sqlText = How to reference Valid SQL cells
    lRow = 1
    Do
        sqlText = Sheets("SQL").Range("A" & lRow)
        If sqlText = "" Then
            MsgBox "Finished processing " & lRow & " rows of SQL", vbOKOnly, "Finished"
            GoTo Wrap_Up
        End If

        Set rs = New ADODB.Recordset
        rs.Open sqlText, conn, adOpenStatic, adLockBatchOptimistic, adCmdText

        Data.Cells(lRow, 1) = sqlText

       If not rs.EOF then
        For iFldCt = 1 To rs.Fields.Count
            Data.Cells(lRow, 1 + iFldCt) = rs.Fields(iFldCt - 1).Name
        Next

        If rs.RecordCount < Rows.Count Then
            Data.Range("B" & lRow).CopyFromRecordset rs
        Else
            Do While Not rs.EOF
               Row = Row + 1
               For Findex = 0 To rs.Fields.Count - 1
                 If Row >= Rows.Count - 50 Then
                    Exit For
                 End If
                 Data.Cells(Row + 1, Findex + 1) = rs.Fields(Findex).value
               Next Findex
               rs.MoveNext
            Loop
        End If
        Cells.EntireColumn.AutoFit
      End If
        lRow = lRow + 1
    Loop
Wrap_Up:
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
End Sub

答案 1 :(得分:0)

我正在使用这个:

Function SQLQueryRun(ByVal query As String, ByVal returnData As Boolean) As Variant
Dim Conn As New ADODB.Connection
Dim ADODBCmd As New ADODB.Command
Dim ret As New ADODB.Recordset

    Conn.ConnectionString = "connection_string_here"
    Conn.Open
    ADODBCmd.ActiveConnection = Conn
    ADODBCmd.CommandText = query
    Set ret = ADODBCmd.Execute()
    If returnData Then
        If Not ret.EOF Then SQLQueryRun = ret.GetRows()
    Else
        SQLQueryRun = True
    End If
    Conn.Close
    Set Conn = Nothing
    Set ret = Nothing
End Function

如果第二个参数是False,则函数不返回任何内容。您是否期望查询运行结果?
我也使用宏从windows剪贴板中包含的sql创建Query / Pivot表,如果你有兴趣请告诉我。

答案 2 :(得分:0)

您需要创建与数据库的连接并遍历所有单元格并在每个单元格中执行代码。

您可以使用ADO建立连接(需要添加对Microsoft ActiveX Data Objects 6.1 Library的引用)

您需要找出connection string,打开连接,然后遍历所有单元格并在这些单元格中执行SQL。

Dim cnn As New ADODB.Connection
Dim connectionString As String
Dim cmd As New ADODB.Command
Dim c As Range, ws As Worksheet
Dim rst as ADODB.Recordset

connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data source=C:\Database3.accdb;Persist Security Info=False;"
cnn.Open connectionString
cmd.ActiveConnection = cnn

For Each c In ws.Range()
    cmd.CommandText = c.Value
    set rst = cmd.Execute 
    'do what you need to with your new recordset before moving on to the next SELECT
Next c