请求编写VBA循环实现SQL查询批量执行及结果导出

Got it, let's get this loop working for your SQL execution task. I've modified your existing code to run continuously until there's no more data in column A, plus added the text file generation and hyperlink functionality you need. Here's the full implementation:

Sub LoopAndExecuteSQL()
    Dim cn As ADODB.Connection
    Dim Sql As String
    Dim Rec_set As ADODB.Recordset
    Dim currentRow As Integer
    Dim outputPath As String
    Dim fileName As String
    Dim fileNum As Integer
    
    ' Set up your database connection (swap in your actual connection string)
    Set cn = New ADODB.Connection
    cn.Open "YourConnectionStringHere"
    
    currentRow = 2 ' Start processing from row 2
    
    ' Loop until we hit an empty cell in column A
    Do While Sheet1.Range("A" & currentRow).Value <> ""
        ' Grab the SQL statement from column A of the current row
        Sql = Sheet1.Range("A" & currentRow).Value
        
        ' Run the SQL query
        Set Rec_set = cn.Execute(Sql)
        
        ' Write results to column B – handles single values or full tables
        If Not Rec_set.EOF Then
            Sheet1.Range("B" & currentRow).CopyFromRecordset Rec_set
        Else
            Sheet1.Range("B" & currentRow).Value = "No results returned"
        End If
        
        ' Create a text file to store the query and results
        outputPath = "C:\YourOutputFolder\" ' Update this to your preferred folder
        fileName = "QueryResult_Row" & currentRow & ".txt"
        fileNum = FreeFile
        
        Open outputPath & fileName For Output As #fileNum
        Print #fileNum, "SQL Query Executed:"
        Print #fileNum, Sql
        Print #fileNum, vbNewLine & "Query Results:"
        
        ' Rewind the recordset to write all results to the file
        Rec_set.MoveFirst
        If Not Rec_set.EOF Then
            ' Write column headers first
            Dim i As Integer
            For i = 0 To Rec_set.Fields.Count - 1
                Print #fileNum, Rec_set.Fields(i).Name; vbTab;
            Next i
            Print #fileNum, vbNewLine
            
            ' Write each row of results
            Do While Not Rec_set.EOF
                For i = 0 To Rec_set.Fields.Count - 1
                    Print #fileNum, Rec_set.Fields(i).Value; vbTab;
                Next i
                Print #fileNum, vbNewLine
                Rec_set.MoveNext
            Loop
        Else
            Print #fileNum, "No results returned"
        End If
        Close #fileNum
        
        ' Add a hyperlink in column C to open the text file
        Sheet1.Hyperlinks.Add _
            Anchor:=Sheet1.Range("C" & currentRow), _
            Address:=outputPath & fileName, _
            TextToDisplay:="View Result File"
        
        ' Clean up for the next iteration
        Rec_set.Close
        Set Rec_set = Nothing
        
        ' Move to the next row
        currentRow = currentRow + 1
    Loop
    
    ' Close the database connection when done
    cn.Close
    Set cn = Nothing
    
    MsgBox "All queries finished running!"
End Sub

A few important things to note: #

• Connection String: Replace "YourConnectionStringHere" with your actual database connection string (this will vary depending on whether you're using SQL Server, Access, MySQL, etc.).
• Output Folder: Update outputPath to a folder that exists on your machine. If you want the code to create the folder automatically if it doesn't exist, add this before the file creation part:

  If Dir(outputPath, vbDirectory) = "" Then
      MkDir outputPath
  End If
  

• Library Reference: Make sure you've enabled the Microsoft ActiveX Data Objects Library in your VBA project. Go to Tools > References and select the latest version available (usually 6.0).
• Result Handling: The code handles both queries that return multiple rows/columns and those that return nothing (it writes a "No results returned" message in both column B and the text file).

内容的提问来源于stack exchange，提问作者abinaya