Многорядный SQL запрос в одну ячейку - PullRequest
Новая
       30

Многорядный SQL запрос в одну ячейку

0 голосов
/ 25 февраля 2020

У меня есть проблема, когда мне нужен многострочный запрос 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

1 Ответ

0 голосов
/ 25 февраля 2020

Исправлено с помощью предложения Тима Уильямса 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
...