как использовать Access VBA для хранения SQL вывода как XML

Question

Моих извинений для описания, я понятия не имею, как назвать это правильно

У меня есть несколько хранимых процедур (работает на SQL2000), которые предоставляют мне данные XML в качестве вывод. Все это работает отлично и, как ожидалось, и я использую модуль VB в своей DTS для экспорта и хранения данных. Уменьшенная версия этого файла выглядит следующим образом

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) 

Поэтому в основном то, что это делает вызвать процедуру, сохранить вывод в поток и сохранить файл, достаточно простой и до сих здесь нет вопроса. Тем не менее, мне также нужно будет сделать это с моего доступа к интерфейсу с помощью VBA. Таким образом, вызывая процедуру, обертывая содержимое и сохраняя его как XML-файл. К сожалению, мое знание VBA немного ржавый ...

Это то, что я в настоящее время:

Dim cnn As ADODB.Connection 
Dim cmd As New ADODB.Command, rs As New ADODB.Recordset 

Set cnn = New ADODB.Connection 
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=myserver;DATABASE=myDatabase;uid=myID;pwd=myPW;Trusted_Connection=Yes" 
cnn.Open cnn.ConnectionString 

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

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

Debug.Print rs(0) 

до сих пор так хорошо, я могу открыть процедуру, я получаю возвращаемые данные, но вот где мое счастье заканчивается. Возвращенные данные, по-видимому, ограничены определенным количеством символов (около 2000), и я изо всех сил стараюсь сохранить его, как я хочу.

Я попробовал ниже для быстрого и грязного теста, но, похоже, он испортил мой XML (все мои атрибуты внезапно дублируются дважды) и, как указано, экспортируется только часть содержимого, поэтому любые советы о том, как делать это должным образом было бы высоко оценено

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

Answer 1

Ничего, я нашел его сам тем временем. У меня было 2 проблемы, VBA ADODB работает по-разному как вариант VB, и поскольку я использовал FOR XML в своем SQL-запросе, вывод был измельчен в разных строках. Следовательно, почему у меня только частичный выход. Поиграв немного с потоковой частью в 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