用VBA生成XML文件

如何解决用VBA生成XML文件

我正在尝试使用VBA代码生成XML文件。

我的目标是更改Excel数据，然后将这些数据导出到有效的XML文件中。我只想在其中包含数据的数据只有一行，而标签的名称只有一行。

如何浏览所有数据并生成XML文件？

一些示例数据（我的原始文件包含更多列和数据）。

（黄色数据是我在XML中的第一个块，绿色数据是我在XML中的第二个块。）

这是XML文件的外观：

db.m5.8xlarge

我的代码：

<?xml version="1.0" encoding="UTF-8"?>

<NmLoader>

<csvBeginTypeDefView handler ="TypeDefinition">
    <csvattTemplate>LW</csvattTemplate>
    <csvnameSpace>default</csvnameSpace>
    <csvname>Tires</csvname>
    <csvcontainerDomain/>
    <csvtypeParent>Wheels</csvtypeParent>
</csvBeginTypeDefView>

<csvBeginAttributeDefView handler = "AttributeDefinition">
    <csvname>TiresAT</csvname>
    <csvattDefClass>Definition</csvattDefClass>
    <csvdatatype>String</csvdatatype>
    <csvIBA>TiresAT</csvIBA>
    <csvQoM/>
</csvBeginAttributeDefView>

</NmLoader>

我尝试过的其他解决方案：

• 我已经用Excel映射了XML，但是Excel无法导出这样的XML模式。
• 通过浏览有关XML导出的帖子，我用VBA（我是初学者）编写了代码。

解决方法

尝试

Option Explicit

Public Sub GenerateXML()

    Dim sht As Worksheet
    Set sht = Worksheets("Data")

    Dim loLetzteZ As Long,loLetzteS As Long,i As Long
    Dim rBereich As Range,rng As Range
    Dim sZeile As String
    Dim strPfad As String
    Dim sTag As String,sTag1 As String,sData As String

    'determine the last possible row
    loLetzteZ = sht.Cells(Rows.Count,1).End(xlUp).Row

    'determine the last possible column
    loLetzteS = sht.Cells(1,Columns.Count).End(xlToLeft).Column

    'set me the area for the complete worksheet
    Set rBereich = sht.Range("A2:" & Cells(loLetzteZ,loLetzteS).Address)

    ' output
    strPfad = ActiveWorkbook.Path & "\Data" & ".xml"

    sTag1 = ""
    sZeile = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf _
    & "<NmLoader>" & vbCrLf

     'row for row
    For Each rng In rBereich.Rows
        With rng

            'column for column
            For i = 1 To .Columns.Count
                sTag = Trim(sht.Cells(1,i))
                sData = Trim(.Cells(1,i))

                'If the tag is handler
                If LCase(Right(sTag,7)) = "handler" Then
                    
                    sTag1 = Split(sTag," ")(0) ' remove handler
                    sZeile = sZeile & "<" & sTag1 & " handler=""" & sData & """>"
                    
                ' is it a closing tag
                ElseIf sTag = sTag1 Then
                    sZeile = sZeile & "</" & sTag1 & ">" & vbCrLf
                    
                ElseIf Len(sData) > 0 Then
                    sZeile = sZeile & vbTab & "<" & sTag & ">" & sData & "</" & sTag & ">"
                Else
                    sZeile = sZeile & vbTab & "<" & sTag & "/>"
                End If

                sZeile = sZeile & vbCrLf
            Next

            'Write line with distance
            sZeile = sZeile & vbCrLf & "</NmLoader>" & vbCrLf

            'Open file and write the text
            Debug.Print sZeile
            'Call InDateiSchreiben(strPfad,sZeile,True)
        End With

    Next
    MsgBox strPfad & " created",vbInformation

End Sub

,

尝试一下

Function GetXmlElement(sTagName As String,_
                       sValue As String,_
                       Optional bUseEmptyTags As Boolean = False,_
                       Optional bMultiline As Boolean = False) As String
    
    Dim sStartOpen As String:   sStartOpen = "<"
    Dim sClose As String:       sClose = ">"
    Dim sEndOpen As String:     sEndOpen = "</"
    Dim sEmptyClose As String:  sEmptyClose = " />"
    Dim sTab As String:         sTab = "    "
        
    Dim sTagValSeparator As String
    Dim sValTagSeparator As String
    If bMultiline Then
        sTagValSeparator = Chr(10) & sTab
        sValTagSeparator = Chr(10)
    End If
    
    If Len(sValue) = 0 And bUseEmptyTags Then
        GetXmlElement = sStartOpen & sTagName & sEmptyClose
    Else
        GetXmlElement = sStartOpen & sTagName & sClose & sTagValSeparator & _
                        Replace(sValue,Chr(10),Chr(10) & sTab) & _
                        sValTagSeparator
        
        If InStr(1,sTagName," ") > 0 Then
            'tag has attributes'
            sTagName = Left(sTagName,InStr(1," ") - 1)
        End If
        
        GetXmlElement = GetXmlElement & sEndOpen & sTagName & sClose
    End If
End Function

Function GetXMLOutput() As String
    Dim lLastCol As Long
    Dim i As Long
    Dim lCsvBeginCol As Long
    Dim sTagName As String
    Dim sInnerElements As String
    Dim sOutput As String
    
    With ThisWorkbook.Sheets("Data")
        lLastCol = .Cells(1,Columns.Count).End(xlToLeft).Column
        
        lCsvBeginCol = 1
        For i = 1 To lLastCol
            sTagName = .Cells(1,i)
            If Left(sTagName,8) = "csvBegin" And i > lCsvBeginCol Or i = lLastCol Then
                ' build the outer element
                sTagName = .Cells(1,lCsvBeginCol) & "=""" & .Cells(2,lCsvBeginCol) & """"
                If Len(sOutput) > 0 Then
                    sOutput = sOutput & Chr(10) & Chr(10)
                End If
                sOutput = sOutput & GetXmlElement(sTagName,sInnerElements,True,True)
                lCsvBeginCol = i
                sInnerElements = ""
            ElseIf i <> lCsvBeginCol Then
                ' build the inner elements
                If Len(sInnerElements) > 0 Then sInnerElements = sInnerElements & Chr(10)
                sInnerElements = sInnerElements & GetXmlElement(sTagName,.Cells(2,i),True)
            End If
        Next i
        
        sOutput = GetXmlElement("NmLoader",sOutput,True)
        sOutput = "<?xml version=""1.0"" encoding=""UTF-8""?>" & Chr(10) & Chr(10) & sOutput
    
        GetXMLOutput = sOutput
        Debug.Print sOutput
    End With
End Function

Sub GenerateXML()
    Dim sFilename As String
    sFilename = ThisWorkbook.Path & "\Data.xml"
    Open sFilename For Output As #1
    Print #1,GetXMLOutput
    Close #1
End Sub