如何将VBA执行Excel SQL查询的结果导出为CSV文件？

你可以通过添加文件写入逻辑，把result这个ADODB.Recordset对象里的内容导出为CSV文件。以下是修改后的完整代码，包含导出功能：

Sub MyMethod()
   '--- Declare Variables to store the connection, the result and the SQL query
   Dim connection As Object, result As Object, sql As String, recordCount As Integer
   Dim outputPath As String, fileNum As Integer
   Dim i As Integer, lineText As String
   
   '--- 设置CSV输出路径（可自行修改）
   outputPath = ThisWorkbook.Path & "\查询结果.csv"
   
   '--- Connect to the current datasource of the Excel file
   Set connection = CreateObject("ADODB.Connection")

With connection
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
    "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    .Open
End With

'--- Write the SQL Query. In this case, we are going to select manually the data range
'--- To print the whole information of the table

'-- full_name = [first name] + " " + [last name]

sql = "SELECT [id], [first name], [last name], [salary], [tax], [salary] - [tax] as saldo, [first name] & chr(32) & [last name] as fullInfo FROM [miTabla1$A1:E3]"
      
'--- Run the SQL query
Set result = connection.Execute(sql)

'--- 打开CSV文件准备写入
fileNum = FreeFile()
Open outputPath For Output As #fileNum

'--- 写入表头
lineText = ""
For i = 0 To result.Fields.Count - 1
   ' 处理包含逗号/引号的字段，用双引号包裹
   If InStr(result.Fields(i).Name, ",") > 0 Or InStr(result.Fields(i).Name, """") > 0 Then
       lineText = lineText & """" & Replace(result.Fields(i).Name, """", """""") & """"
   Else
       lineText = lineText & result.Fields(i).Name
   End If
   ' 添加分隔符（最后一列不加）
   If i < result.Fields.Count - 1 Then lineText = lineText & ","
Next i
Print #fileNum, lineText

'--- 写入数据行
recordCount = 0
Do While Not result.EOF
    lineText = ""
    For i = 0 To result.Fields.Count - 1
        ' 处理字段值中的特殊字符
        Dim fieldValue As String
        fieldValue = Nz(result.Fields(i).Value, "") ' 处理空值
        If InStr(fieldValue, ",") > 0 Or InStr(fieldValue, """") > 0 Or InStr(fieldValue, vbCrLf) > 0 Then
            lineText = lineText & """" & Replace(fieldValue, """", """""") & """"
        Else
            lineText = lineText & fieldValue
        End If
        If i < result.Fields.Count - 1 Then lineText = lineText & ","
    Next i
    Print #fileNum, lineText
    result.MoveNext
    recordCount = recordCount + 1
Loop

'--- 关闭文件和连接
Close #fileNum
result.Close
connection.Close
Set result = Nothing
Set connection = Nothing

'--- 输出结果提示
Debug.Print vbNewLine & recordCount & " results found."
MsgBox "CSV文件已导出至：" & outputPath, vbInformation
End Sub

关键说明： #

• 输出路径：outputPath变量定义了CSV的保存位置，默认在当前工作簿同目录下，可自行修改路径和文件名。
• 表头写入：遍历Recordset的字段名，处理包含逗号、引号的字段（用双引号包裹，内部引号替换为两个双引号，符合CSV规范）。
• 数据行写入：
  • 用Nz函数处理空值，避免导出时出现错误。
  • 同样处理包含特殊字符的字段，确保CSV格式正确。
• 资源释放：最后关闭文件、Recordset和Connection，避免资源泄漏。

如果你需要用分号作为分隔符（适配部分地区的CSV格式），只需把代码中所有的,替换为;即可。

内容的提问来源于stack exchange，提问作者Jose Cabrera Zuniga