从SQL Server数据库中提取XML字符串并将其导入Excel

I have unformatted XML data in a column of a SQL Server database. I want to extract it and reformat it so I can import it into Excel. What is the best way to do this?

我在SQL Server数据库的列中有未格式化的XML数据。我想提取它并重新格式化,以便我可以将其导入Excel。做这个的最好方式是什么?

Right now, I'm trying to extract it to a file and then import it but it isn't working, and by that, I mean it does nothing. I have to extract it to a file, open it in notepad++ and using the XML tools add-in to format it using Pretty print (XML - only with linebreaks) and then it imports just fine. I'd like to be able to just pass it through a function that reformats the XML that way and import it without using a file at all. Here is the code I have so far:

现在,我正在尝试将其解压缩到一个文件,然后导入它但它无法正常工作,我认为它什么都不做。我必须将它解压缩到一个文件,在notepad ++中打开它,并使用XML工具加载项使用Pretty print(XML - 仅使用换行符)对其进行格式化,然后导入就好了。我希望能够通过一个函数来传递它,这个函数以这种方式重新格式化XML并导入它而不使用任何文件。这是我到目前为止的代码:

Sub DataExtractToFile()

Dim fFile As Long
Dim strFile As String

strFile = Environ("temp") & "\ugly.xml"
If FileThere(strFile) Then Kill strFile
strFile = Environ("temp") & "\ugly.xml"

fFile = FreeFile

' Create a connection object.
Dim cnITrade As ADODB.Connection
Set cnITrade = New ADODB.Connection

' Provide the connection string.
Dim strConn As String

'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"

'Connect to the InternationalTrade database on the local server.
strConn = strConn & "DATA SOURCE=.\SQLExpress;INITIAL CATALOG=ITrade;"

'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"

'Now open the connection.
cnITrade.Open strConn

' Create a recordset object.
Dim rsITrade As ADODB.Recordset
Set rsITrade = New ADODB.Recordset

With rsITrade
    ' Assign the Connection object.
    .ActiveConnection = cnITrade
    ' Extract the required records.
    .Open "SELECT xml_msg FROM TABLE with (nolock) where xml_msg like '%ABC01156%'"
                    Open strFile For Output As #fFile
                    Print #fFile, .GetString(adClipString, 1, "><", vbCrLf, "")
    ' Tidy up
     Close #fFile
    .Close
End With

cnITrade.Close
Set rsITrade = Nothing
Set cnITrade = Nothing

End Sub

Function FileThere(FileName As String) As Boolean
         FileThere = (Dir(FileName) > "")
End Function


Sub ImportXML(sPath As String)

        ActiveWorkbook.XmlImportXml sPath, ImportMap:= _
                Nothing, Overwrite:=True, Destination:=Range("$A$1")
End Sub

Here is an example of the unformatted XML

以下是未格式化XML的示例

<Proponix><Header><DestinationID>ABC</DestinationID><SenderID>PRO</SenderID><ClientBank>123</ClientBank><OperationOrganizationID>ABC1</OperationOrganizationID><MessageType>MSG</MessageType><DateSent>20100104</DateSent><TimeSent>161601</TimeSent><MessageID>0000007522</MessageID></Header><SubHeader><InstrumentID>ABC123456</InstrumentID><InstrumentStatus>ABC</InstrumentStatus><ActivityType>CUS</ActivityType><ActivityStatus>REL</ActivityStatus><BusinessDate>20100104</BusinessDate><OriginalActivityType>CUS</OriginalActivityType><RelatedInstrumentID>AB1241550001</RelatedInstrumentID><RelatedActivitySequenceNo>1</RelatedActivitySequenceNo><ProductType>OUT</ProductType><Product>TAC</Product><ProductCategory>US</ProductCategory><RelationshipCustomerID>DESI0101156</RelationshipCustomerID><LimitCustomerID>DESI0101156</LimitCustomerID><BaseCurrency>USD</BaseCurrency><InstrumentCurrency>USD</InstrumentCurrency><LimitCurrency>USD</LimitCurrency><MessageSequenceNumber>000000000020106</MessageSequenceNumber></SubHeader><Body><Activity><DateActivity>20091230</DateActivity><ActivitySequenceNo>0</ActivitySequenceNo><SequenceDate>20100104</SequenceDate><SequenceTime>161559</SequenceTime><ActivityAmount>120506.00</ActivityAmount></Activity><ResultingTerms><InstrumentTerms><DateStart>20091230</DateStart><DateEnd>20100318</DateEnd><ReissuanceInd>N</ReissuanceInd><ConvertedInd>N</ConvertedInd><CountryRisk>US</CountryRisk><TenorCategory>T</TenorCategory></InstrumentTerms><UsanceTerms><DispositionType>HELD</DispositionType><UnconfirmedInd>Y</UnconfirmedInd><NumberOfDays>78</NumberOfDays><TenorDetailType>AFM</TenorDetailType></UsanceTerms></ResultingTerms><Parties><Party><PartyType>DWR</PartyType><CustomerID>ABCI0101156</CustomerID><ReferenceNo>04-COMPUTER-09</ReferenceNo></Body></Proponix>

And Pretty printed XML

和漂亮的打印XML

<Proponix>
    <Header>
        <DestinationID>ABC</DestinationID>
        <SenderID>PRO</SenderID>
        <ClientBank>123</ClientBank>
        <OperationOrganizationID>ABC1</OperationOrganizationID>
        <MessageType>MSG</MessageType>
        <DateSent>20100104</DateSent>
        <TimeSent>161601</TimeSent>
        <MessageID>0000007522</MessageID>
    </Header>
    <SubHeader>
        <InstrumentID>ABC123456</InstrumentID>
        <InstrumentStatus>ABC</InstrumentStatus>
        <ActivityType>CUS</ActivityType>
        <ActivityStatus>REL</ActivityStatus>
        <BusinessDate>20100104</BusinessDate>
        <OriginalActivityType>CUS</OriginalActivityType>
        <RelatedInstrumentID>AB1241550001</RelatedInstrumentID>
        <RelatedActivitySequenceNo>1</RelatedActivitySequenceNo>
        <ProductType>OUT</ProductType>
        <Product>TAC</Product>
        <ProductCategory>US</ProductCategory>
        <RelationshipCustomerID>DESI0101156</RelationshipCustomerID>
        <LimitCustomerID>DESI0101156</LimitCustomerID>
        <BaseCurrency>USD</BaseCurrency>
        <InstrumentCurrency>USD</InstrumentCurrency>
        <LimitCurrency>USD</LimitCurrency>
        <MessageSequenceNumber>000000000020106</MessageSequenceNumber>
    </SubHeader>
    <Body>
        <Activity>
            <DateActivity>20091230</DateActivity>
            <ActivitySequenceNo>0</ActivitySequenceNo>
            <SequenceDate>20100104</SequenceDate>
            <SequenceTime>161559</SequenceTime>
            <ActivityAmount>120506.00</ActivityAmount>
        </Activity>
        <ResultingTerms>
            <InstrumentTerms>
                <DateStart>20091230</DateStart>
                <DateEnd>20100318</DateEnd>
                <ReissuanceInd>N</ReissuanceInd>
                <ConvertedInd>N</ConvertedInd>
                <CountryRisk>US</CountryRisk>
                <TenorCategory>T</TenorCategory>
            </InstrumentTerms>
            <UsanceTerms>
                <DispositionType>HELD</DispositionType>
                <UnconfirmedInd>Y</UnconfirmedInd>
                <NumberOfDays>78</NumberOfDays>
                <TenorDetailType>AFM</TenorDetailType>
            </UsanceTerms>
        </ResultingTerms>
        <Parties>
            <Party>
                <PartyType>DWR</PartyType>
                <CustomerID>ABCI0101156</CustomerID>
                <ReferenceNo>04-COMPUTER-09</ReferenceNo>
            </Party>            
        <Parties>
    </Body>
</Proponix>

1 个解决方案

#1

I figured it out. Here is the code I came up with. It needs a little bit of polishing but it gets the job done.

我想到了。这是我想出的代码。它需要一点点抛光,但它完成了工作。

Sub DataExtractToFile()

Dim fFile As Long
Dim strFile As String

strFile = Environ("temp") & "\_.xml"
If FileThere(strFile) Then Kill strFile
strFile = Environ("temp") & "\_.xml"

fFile = FreeFile

' Create a connection object.
Dim cnITrade As ADODB.Connection
Set cnITrade = New ADODB.Connection

' Provide the connection string.
Dim strConn As String

'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"

'Connect to the InternationalTrade database on the local server.
strConn = strConn & "DATA SOURCE=.\SQLExpress;INITIAL CATALOG=ITrade;"

'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"

'Now open the connection.
cnITrade.Open strConn

' Create a recordset object.
Dim rsITrade As ADODB.Recordset
Set rsITrade = New ADODB.Recordset


With rsITrade
    ' Assign the Connection object.
    .ActiveConnection = cnITrade
    ' Extract the required records.
    .Open "SELECT xml_msg FROM Table with (nolock) where xml_msg like '%ABC0101156%'"
                    Open strFile For Output As #fFile
                    Print #fFile, .GetString(adClipString)
    ' Tidy up
     Close #fFile
    .Close
End With

cnITrade.Close
Set rsITrade = Nothing
Set cnITrade = Nothing

Open strFile For Input As #fFile
Line Input #fFile, strFile
Close #fFile

ImportXML PrettyPrintXML(strFile)

End Sub


Function FileThere(FileName As String) As Boolean
         FileThere = (Dir(FileName) > "")
End Function


Sub ImportXML(sPath As String)

        ActiveWorkbook.XmlImportXml sPath, ImportMap:= _
                Nothing, Overwrite:=True, Destination:=Range("$A$1")
End Sub

Function PrettyPrintXML(strXML As String) As String

Dim xDoc As MSXML2.DOMDocument60
Set xDoc = New MSXML2.DOMDocument60
Dim xDocStyle As MSXML2.DOMDocument60
Set xDocStyle = New MSXML2.DOMDocument60
Dim xDocOut As MSXML2.DOMDocument60
Set xDocOut = New MSXML2.DOMDocument60
Dim strXMLStyleSheet As String

strXMLStyleSheet = "<xsl:stylesheet" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  xmlns:xsl=""http://www.w3.org/1999/XSL/Transform""" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  version=""1.0"">" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "<xsl:output method=""xml"" indent=""yes""/>" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "<xsl:template match=""@* | node()"">" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  <xsl:copy>" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "    <xsl:apply-templates select=""@* | node()""/>" & cbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  </xsl:copy>" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "</xsl:template>" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "</xsl:stylesheet>"

With xDocStyle
    .async = False
    .validateOnParse = False
    .resolveExternals = False
    .LoadXML strXMLStyleSheet
End With

With xDoc
    .async = False
    .validateOnParse = False
    .resolveExternals = False
    .LoadXML strXML
    .transformNodeToObject xDocStyle, xDocOut
End With

PrettyPrintXML = xDocOut.XML

Set xDocOut = Nothing
Set xDocStyle = Nothing
Set xDoc = Nothing

End Function

#1

I figured it out. Here is the code I came up with. It needs a little bit of polishing but it gets the job done.

我想到了。这是我想出的代码。它需要一点点抛光,但它完成了工作。

Sub DataExtractToFile()

Dim fFile As Long
Dim strFile As String

strFile = Environ("temp") & "\_.xml"
If FileThere(strFile) Then Kill strFile
strFile = Environ("temp") & "\_.xml"

fFile = FreeFile

' Create a connection object.
Dim cnITrade As ADODB.Connection
Set cnITrade = New ADODB.Connection

' Provide the connection string.
Dim strConn As String

'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"

'Connect to the InternationalTrade database on the local server.
strConn = strConn & "DATA SOURCE=.\SQLExpress;INITIAL CATALOG=ITrade;"

'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"

'Now open the connection.
cnITrade.Open strConn

' Create a recordset object.
Dim rsITrade As ADODB.Recordset
Set rsITrade = New ADODB.Recordset


With rsITrade
    ' Assign the Connection object.
    .ActiveConnection = cnITrade
    ' Extract the required records.
    .Open "SELECT xml_msg FROM Table with (nolock) where xml_msg like '%ABC0101156%'"
                    Open strFile For Output As #fFile
                    Print #fFile, .GetString(adClipString)
    ' Tidy up
     Close #fFile
    .Close
End With

cnITrade.Close
Set rsITrade = Nothing
Set cnITrade = Nothing

Open strFile For Input As #fFile
Line Input #fFile, strFile
Close #fFile

ImportXML PrettyPrintXML(strFile)

End Sub


Function FileThere(FileName As String) As Boolean
         FileThere = (Dir(FileName) > "")
End Function


Sub ImportXML(sPath As String)

        ActiveWorkbook.XmlImportXml sPath, ImportMap:= _
                Nothing, Overwrite:=True, Destination:=Range("$A$1")
End Sub

Function PrettyPrintXML(strXML As String) As String

Dim xDoc As MSXML2.DOMDocument60
Set xDoc = New MSXML2.DOMDocument60
Dim xDocStyle As MSXML2.DOMDocument60
Set xDocStyle = New MSXML2.DOMDocument60
Dim xDocOut As MSXML2.DOMDocument60
Set xDocOut = New MSXML2.DOMDocument60
Dim strXMLStyleSheet As String

strXMLStyleSheet = "<xsl:stylesheet" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  xmlns:xsl=""http://www.w3.org/1999/XSL/Transform""" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  version=""1.0"">" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "<xsl:output method=""xml"" indent=""yes""/>" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "<xsl:template match=""@* | node()"">" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  <xsl:copy>" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "    <xsl:apply-templates select=""@* | node()""/>" & cbCrLf
strXMLStyleSheet = strXMLStyleSheet & "  </xsl:copy>" & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "</xsl:template>" & vbCrLf & vbCrLf
strXMLStyleSheet = strXMLStyleSheet & "</xsl:stylesheet>"

With xDocStyle
    .async = False
    .validateOnParse = False
    .resolveExternals = False
    .LoadXML strXMLStyleSheet
End With

With xDoc
    .async = False
    .validateOnParse = False
    .resolveExternals = False
    .LoadXML strXML
    .transformNodeToObject xDocStyle, xDocOut
End With

PrettyPrintXML = xDocOut.XML

Set xDocOut = Nothing
Set xDocStyle = Nothing
Set xDoc = Nothing

End Function

秒客网

从SQL Server数据库中提取XML字符串并将其导入Excel

1 个解决方案

#1

#1

相关文章