时间戳

首页 > 解决方案 > 多行 SQL 查询到单个单元格

excel - 多行 SQL 查询到单个单元格

问题描述

我有一个问题，我需要我的多行 SQL 查询（仅一列）将结果放入一个单元格。有没有办法做到这一点？

这是我正在使用的代码，我需要将它放入一个单元格的原因是因为在这部分之后我有另一部分代码将一列中的所有单元格写入单独的 XML 文件。

我正在尝试将我的多行查询放入一个单元格中，或者如果可以将其作为变量获取，我可以将其嵌入到我的 XML 创建代码中。

非常感谢所有帮助，如果需要更多信息，请告诉我

Dim adoDbConn As New ADODB.Connection
Dim adoDbRs As New ADODB.Recordset
Dim selectCmd As New ADODB.Command
Dim connstring As String

    Dim UID As String
    Dim PWD As String
    Dim Server As String
' Open connection to the SQL Server database
    UID = Worksheets(4).Cells(2, 2).Value       'Username
    PWD = Worksheets(4).Cells(3, 2).Value       'Password
    Server = Worksheets(4).Cells(4, 2).Value    'Database
    connstring = "PROVIDER=MSDAORA.Oracle;DATA SOURCE=" & Server & ";" & "USER ID=" & UID & ";PASSWORD=" & PWD 'Note, I am using MSDAORA as I use an ORACLE DB, you will need to change it for what DB you are using

    adoDbConn.Open connstring
    'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value
    adoDbConn.CommandTimeout = 900
    ' Execute the select query
   selectCmd.ActiveConnection = adoDbConn
   selectCmd.CommandText = Worksheets(1).Cells(ActiveCell.Row, 13).Value
Set adoDbRs = selectCmd.Execute(, , adCmdText)
' Activate the Worksheet
Dim ws As Worksheet
Set ws = Worksheets(1)
   ws.Activate
' Put the query results starting from cell N2
If adoDbRs.EOF = False Then ws.Cells(ActiveCell.Row, 14).CopyFromRecordset adoDbRs
' Close the connection and free the memory
   adoDbRs.Close
Set adoDbRs = Nothing
Set selectCmd = Nothing
   adoDbConn.Close
Set adoDbConn = Nothing

标签： excelvbarecordset

解决方案

通过使用评论中的 Tim Williams 建议myValue = adoDbRs.GetString()并嵌入我的 XML 文件创建以使用该值而不是单元格值来修复。

Dim adoDbRs As New ADODB.Recordset
Dim selectCmd As New ADODB.Command
Dim connstring As String

Dim UID As String
Dim PWD As String
Dim Server As String
' Open connection to the SQL Server database
    UID = Worksheets(4).Cells(2, 2).Value       'Användarnamn
    PWD = Worksheets(4).Cells(3, 2).Value       'Lösenord
    Server = Worksheets(4).Cells(4, 2).Value    'Databas
    connstring = "PROVIDER=MSDAORA.Oracle;DATA SOURCE=" & Server & ";" & "USER ID=" & UID & ";PASSWORD=" & PWD 'Note, I am using MSDAORA as I use an ORACLE DB, you will need to change it for what DB you are using

    adoDbConn.Open connstring
    'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value
    adoDbConn.CommandTimeout = 900
    ' Execute the select query
   selectCmd.ActiveConnection = adoDbConn
   selectCmd.CommandText = Worksheets(1).Cells(ActiveCell.Row, 13).Value
Set adoDbRs = selectCmd.Execute(, , adCmdText)

' Activate the Worksheet
Dim ws As Worksheet
Set ws = Worksheets(1)
   ws.Activate

' Put the query results into string
Dim QueryResult As String
    QueryResult = adoDbRs.GetString()

' Close the connection and free the memory
   adoDbRs.Close
Set adoDbRs = Nothing
Set selectCmd = Nothing
   adoDbConn.Close
Set adoDbConn = Nothing

' Create XML file
Dim strPath As String
Dim strName As String
Dim FSO As Object
Dim oFile As Object
Dim c As Range

    strName = Worksheets(1).Cells(ActiveCell.Row, 15).Value
    strPath = Worksheets(4).Cells(7, 2).Value

Set FSO = CreateObject("Scripting.FileSystemObject")


    Set oFile = FSO.CreateTextFile(strPath & strName)
    oFile.Write QueryResult
    oFile.Close

推荐阅读