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中存储null。但你有两个选择

缺少标记，将被视为空
制作属性nillable = true

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>

您还可以使用传统逻辑和内部VB6 I / O语句来强制执行并将其写为文件。如果您需要真正的UTF-8输出或其他东西，或者您的XML架构更复杂，它只会有点小问题。

使用VB 6.0将数据从Recordset保存到XML

2 个答案: