如何将 XML 读入 ADODB.执行查询 XML 自动的 SQL 存储过程输出中的流对象

Question

我有一个存储过程，它返回一个记录集（一列存储了 XSLT）和一个 XML 文档。

查询基本上是：

SELECT abc, 123
FROM TABLE_A
FOR XML AUTO

我需要从 VBA 应用程序调用存储过程，大概使用 ADO。我只找到了几个谷歌搜索的例子，似乎没有一个有效。

这是我的"代码"：

Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim oStream As New ADODB.Stream
Dim xml As MSXML2.DOMDocument60
Dim strXSLT As String
Dim strXML As String
Dim oFSO As New FileSystemObject
Dim TS As TextStream
oConn.ConnectionString = "Provider='sqloledb';Data Source='[myServer]';" & _
    "Initial Catalog='[myDB]';Integrated Security='SSPI';"
oConn.Open
Set oRS = oConn.Execute("exec dbo.sp_mySproc @Person ='" & gStrUserID & "', @Dash='Main'")
If Not (oRS.BOF And oRS.EOF) Then
    Set TS = oFSO.CreateTextFile("M:DesktoptestMain.XSL", True)
    TS.Write oRS(0).Value
    TS.Close
    Set oRS = oRS.NextRecordset
    xml.loadXML oRS.Fields(oRS.Fields(0).Name)
    Set pi = xml.createProcessingInstruction("xml", _
         "version=""1.0"" encoding=""" & rst.Fields("XMLEncoding") & """")
    xml.insertBefore pi, xml.firstChild
    xml.Save "M:DesktoptestMain.XML"

Set TS = oFSO.CreateTextFile("M:DesktoptestMain.XML", True)
TS.Write "<?xml version=" & Chr(22) & "1.0" & Chr(22) & "?>" & vbCrLf & "<?xml-stylesheet type=" & Chr(22) & "text/xsl" & Chr(22) & " href=" & Chr(22) & "testmain.xsl" & Chr(22) & "?>" & vbCrLf
TS.Write oStream.ReadText
TS.Close

一切正常，因为它将执行存储过程，从记录集中获取 XSL 并将其保存到磁盘，但在我执行oRS.NextRecordset后悲惨地死去。

实际上，我的代码有两种不同的尝试来保存XML;使用TextStream和DOMDocument60（两者都不起作用）。 任何想法将不胜感激...

话筒

Answer 1

经过大量的试验和错误，我找到了一个解决方案：

Private Function GetXML(myConnection As ADODB.Connection, Sproc As String, XSLSuccess As Boolean, GUID As String, Optional Param2 As String = "") As Boolean
Dim sStreamQuery As New ADODB.Stream
Dim cmCmd As New ADODB.Command
Dim strQuery As String
Dim sResponseStream As New ADODB.Stream
Dim strXML As String
Dim oFSO As New FileSystemObject
Dim TS As TextStream
Set cmCmd.ActiveConnection = myConnection
' Set up the Template Query
strQuery = "<ROOT xmlns:sql='urn:schemas-microsoft-com:xml-sql'>"
strQuery = strQuery & "<sql:header>"
strQuery = strQuery & "<sql:param name='Param1'>" & gStrParam1 & "</sql:param>"
If gStrParam2 <> "" Then
    strQuery = strQuery & "<sql:param name='Param2'>" & gStrParam2 & "</sql:param>"
End If
strQuery = strQuery & "</sql:header>"
strQuery = strQuery & "<sql:query >"
If gStrParam2 <> "" Then
    strQuery = strQuery & "exec dbo." & Sproc & " @Param1, @Param2"
Else
    strQuery = strQuery & "exec dbo." & Sproc & " @Param1"
End If
strQuery = strQuery & "</sql:query>"
strQuery = strQuery & "</ROOT>"
' Read the template query into the Stream
'Set sStreamQuery = New Stream
sStreamQuery.Open
sStreamQuery.WriteText strQuery, adWriteChar
sStreamQuery.Position = 0
' Associate the stream with the command and set the
' dialect to XML to interpret it
Set cmCmd.CommandStream = sStreamQuery
cmCmd.Dialect = "{5D531CB2-E6Ed-11D2-B252-00C04F681B71}"
' Create a stream to handle the response
sResponseStream.Open
' Can also be a response object in an ASP page
cmCmd.Properties("Output Stream") = sResponseStream
cmCmd.Execute , , adExecuteStream
strXML = Replace(sResponseStream.ReadText, "<ROOT xmlns:sql=" & Chr(34) & "urn:schemas-microsoft-com:xml-sql" & Chr(34) & ">", "", 1)
strXML = Replace(strXML, "</ROOT>", "", 1)
Set TS = oFSO.CreateTextFile(gstrPath & GUID & ".XML", True)
TS.Write "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" & vbCrLf
If XSLSuccess Then
    TS.Write "<?xml-stylesheet type=" & Chr(34) & "text/xsl" & Chr(34) & " href=" & Chr(34) & GUID & ".xsl" & Chr(34) & "?>" & vbCrLf
End If
TS.Write strXML
TS.Close
Set TS = Nothing
Set oFSO = Nothing

sResponseStream.Close
sStreamQuery.Close
Set responseStream = Nothing
Set sStreamQuery = Nothing
Set cmCmd = Nothing
End Function