Ms access 如何使用access VBA将SQL输出存储为XML

很抱歉，我不知道如何正确命名

我有几个存储过程（在SQL2000上运行），它们向我提供XML数据作为输出。这一切都很好，正如预期的那样，我正在我的DTS中使用一个VB模块来导出和存储数据。此文件的简化版本如下所示

set objStream   = CreateObject( "ADODB.Stream" ) 
set objXML  = CreateObject( "MSXML2.DOMDocument" ) 

set objConn = CreateObject( "ADODB.Connection" ) 
objConn.ConnectionTimeout = 3600
objConn.CommandTimeOut = 0
ObjConn.open(DTSGlobalVariables("ConnStringConso").Value)

set objComm          = CreateObject( "ADODB.Command" )  
objComm.ActiveConnection = objConn 
objComm.CommandType      = adCmdStoredProc

'Create the Stream object
set objStream = CreateObject( "ADODB.Stream" ) 
objStream.Open  
objComm.Properties( "Output Stream" ) = objStream       

' Execute the command

objComm.CommandText = "my_stored_procedure"     
objComm.CommandTimeout = 3600
objComm.Execute ,, adExecuteStream 

' Read the info returned adding the header and footer info
objStream.Position = 0 
objXML.LoadXML("<?xml version='1.0'?>" & objStream.ReadText) 

' Create the output XML file
xmlfile = filePath & "myfile.xml"
objXML.save( xmlfile )

到目前为止还不错，我可以打开程序，我得到返回的数据，但这就是我的运气结束的地方。返回的数据似乎被限制在一定数量的字符（大约2000个）内，我正在努力将其保存为我想要的

我在下面尝试了快速而肮脏的测试，但它似乎破坏了我的XML（我所有的属性都突然被双引号引用），并且如上所述，只有一部分内容被导出，因此任何关于如何正确执行的建议都将不胜感激

Dim myFile As String
myFile = "d:\output.xml"
Open myFile For Output As #1
Write #1, rs(0)
Close #1

---

没关系，同时我自己也找到了。我有两个问题，VBA ADODB与VB变体的工作原理不同，当我在SQL查询中使用FOR XML时，输出显然被切分为不同的行。因此，我只有部分输出。在VBA中稍微修改一下流式处理部分，并遍历所有记录，使其工作正常。不太确定这是最理想的方法，所以如果有改进的方法，我很想知道

Dim cmd As New ADODB.Command, rs As New ADODB.Recordset
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=myServer;DATABASE=myDB;uid=myID;pwd=myPW;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString

Set cmd = New ADODB.Command
With cmd
    .ActiveConnection = cnn
    .CommandType = adCmdStoredProc
    .CommandText = myProc
End With

rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd

Dim myXML As Variant

If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True
        myXML = myXML & rs.Fields(0)
        rs.MoveNext
    Loop
End If

'Create the Stream object
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = 2 'Text
    .Charset = "utf-8"
    .Open
    .WriteText myXML
    .SaveToFile (filePath & myXMLFile)
    .Close

End With

Dim cmd As New ADODB.Command, rs As New ADODB.Recordset
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=myServer;DATABASE=myDB;uid=myID;pwd=myPW;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString

Set cmd = New ADODB.Command
With cmd
    .ActiveConnection = cnn
    .CommandType = adCmdStoredProc
    .CommandText = myProc
End With

rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd

Dim myXML As Variant

If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True
        myXML = myXML & rs.Fields(0)
        rs.MoveNext
    Loop
End If

'Create the Stream object
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = 2 'Text
    .Charset = "utf-8"
    .Open
    .WriteText myXML
    .SaveToFile (filePath & myXMLFile)
    .Close

End With