使用VB 6.0將記錄集中的數據保存到XML

Question

Dim Rs As New `Adodb.Recordset` 
Rs.Open "select * from Customer ",Conn,adOpenDynamic,adLockOptimistic 
if Rs.RecordCount > 0 then 
    rs.Save App.Path & "\Customer.xml" , adPersistXML 
end if 

問題是記錄爲空時數據未存儲在xml中。

那麼如何讓所有存儲的數據都變成xml數據包括null。

Answer 1

如果你能向我們展示XML結構，它會更有幫助。您不能直接在XML中存儲空值。但是，你有兩個選擇

• 要麼缺失，這將被視爲無效
• 製作屬性標記的nillable =真

---

Answer 2

你不能強迫一個Null值導出爲XML那樣。 ADO行集架構旨在有意地「省略」它們。

您還沒有給出一個具體的模式創建的，但你可以很容易地模仿ADO模式，如果你想。

最好的方法是自己控制過程。下面是一個例子SAX雖然我沒有刻意去模仿ADO模式在這裏：

Option Explicit 
' 
'Requires references to: 
' 
' Microsoft ActiveX Data Objects, version 2.5 or later. 
' Microsoft XML 6.0, can be rewritten to use 3.0 as well. 
' 

Private Enum HRESULT 
    S_OK = 0 
End Enum 

Private Enum STGM 
    STGM_READ = &H0& 
    STGM_WRITE = &H1& 
    STGM_READWRITE = &H2& 
    STGM_SHARE_EXCLUSIVE = &H10& 
    STGM_SHARE_DENY_WRITE = &H20& 
    STGM_SHARE_DENY_READ = &H30& 
    STGM_SHARE_DENY_NONE = &H40& 
    STGM_FAILIFTHERE = &H0& 
    STGM_CREATE = &H1000& 
End Enum 

Private Declare Function SHCreateStreamOnFile Lib "shlwapi" _ 
    Alias "SHCreateStreamOnFileW" (_ 
    ByVal pszFile As Long, _ 
    ByVal grfMode As STGM, _ 
    ByRef stm As IUnknown) As HRESULT 

Private Sub CustomSaveXML(_ 
    ByVal Recordset As ADODB.Recordset, _ 
    ByVal FilePath As String) 
    Dim Stream As IUnknown 
    Dim HRESULT As HRESULT 
    Dim Attributes As SAXAttributes60 
    Dim Writer As MSXML2.MXXMLWriter60 
    Dim Handler As MSXML2.IVBSAXContentHandler 
    Dim Field As ADODB.Field 
    Dim StringValue As String 

    Set Stream = Nothing 'Force creation on 64-bit Windows. Not sure why 
         'this is required or why it works. 
    HRESULT = SHCreateStreamOnFile(StrPtr(FilePath), _ 
            STGM_CREATE _ 
           Or STGM_WRITE _ 
           Or STGM_SHARE_EXCLUSIVE, _ 
            Stream) 
    If HRESULT <> S_OK Then 
     Err.Raise &H80044900, _ 
        "CustomSaveXML", _ 
        "SHCreateStreamOnFile error " & Hex$(HRESULT) 
    End If 
    Set Attributes = New MSXML2.SAXAttributes60 
    Set Writer = New MSXML2.MXXMLWriter60 
    Set Handler = Writer 
    With Writer 
     .omitXMLDeclaration = True 
     .standalone = True 
     .disableOutputEscaping = False 
     .indent = True 
     .encoding = "utf-8" 
     .output = Stream 
    End With 
    With Handler 
     .startDocument 
     .startElement "", "", "data", Attributes 
     Do Until Recordset.EOF 
      With Attributes 
       For Each Field In Recordset.Fields 
        Select Case VarType(Field.Value) 
         Case vbNull 
          'Force as empty String: 
          StringValue = "" 
         Case vbString 
          StringValue = Field.Value 
         Case Else 
          'This converts to a String value using the 
          'Invariant Locale: 
          StringValue = LTrim$(Str$(Field.Value)) 
        End Select 
        .addAttribute "", "", Field.Name, "", StringValue 
       Next 
      End With 
      .startElement "", "", "row", Attributes 
      .endElement "", "", "row" 
      Attributes.Clear 
      Recordset.MoveNext 
     Loop 
     .endElement "", "", "data" 
     .endDocument 
    End With 
End Sub 

Private Sub Main() 
    Dim RS As ADODB.Recordset 

    With New ADODB.Connection 
     .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='.';" _ 
       & "Extended Properties='Text;CSVDelimited=True;Hdr=True'" 
     Set RS = .Execute("sample.csv", , adCmdTableDirect) 
     CustomSaveXML RS, "sample2.xml" 
     RS.Close 
     .Close 
    End With 
End Sub 

輸入數據：

LongVal,StringVal,DoubleVal 
65536,Fred,3.5 
,Has-Null,1.23456 
65537,Barney,37 

輸出XML：

<data> 
    <row LongVal="65536" StringVal="Fred" DoubleVal="3.5"/> 
    <row LongVal="" StringVal="Has-Null" DoubleVal="1.23456"/> 
    <row LongVal="65537" StringVal="Barney" DoubleVal="37"/> 
</data> 

你也可以brute-使用傳統的邏輯和內在的VB6 I/O語句將事物強制寫入文件。如果你需要真正的UTF-8輸出或者其他東西，或者你的XML模式更復雜，它就會變得更有趣。