excel数据写入xml文件

把一个文本文件追加写入另外一个文件
Private Sub ApplendText(TargetFile As String, SourceFile As String)
Dim lineStr As String, outer As String
Open SourceFile For Input As #1
Do Until EOF(1)
Line Input #1, lineStr
outer = outer & lineStr & vbCrLf
Loop
Close #1
Open TargetFile For Append As #1
Print #1, outer
Close #1
MsgBox "read and write finished！"
End Sub

excel导出为xml文件
Private Sub CommandButton1_Click()
If MsgBox("Are you sure create xml?", vbYesNo) = vbYes Then
ActiveWorkbook.Save
Dim xlsname, filepath
Dim irow%, icol%
xlsname = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
filepath = ThisWorkbook.Path

    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Open
    objStream.Position = 0
    objStream.Charset = "UTF-8"
    objStream.writetext "<MatML_Doc> " & vbCrLf
    For irow = 2 To Cells(Rows.Count, 1).End(3).Row
        objStream.writetext vbTab & "<Material>" & vbCrLf
        objStream.writetext vbTab & vbTab & "<BulkDetails>" & vbCrLf
        Dim materialName
        materialName = Cells(irow, 3) + " " + Cells(irow, 6) + Cells(irow, 7)
        If Cells(irow, 8) <> "" Then
            materialName = materialName + "-" + Cells(irow, 8)
        End If
     
        objStream.writetext vbTab & vbTab & vbTab & "<Name>" & materialName & "</Name>" & vbCrLf
        objStream.writetext vbTab & vbTab & vbTab & "<Class> <Name>" & Cells(irow, 1) & "</Name></Class>" & vbCrLf
        
    Next
    
    'here add meta data
      
    objStream.SaveToFile filepath + "\" + xlsname + ".xml", 2

    objStream.Close
    Set objStream = Nothing
    
    Dim TargetFileName As String
    TargetFileName = filepath + "\" + xlsname + ".xml"
    MsgBox TargetFileName
    
    Dim SourceFileName As String
    SourceFileName = filepath + "\metadata.xml"
    Call ApplendText(TargetFileName, SourceFileName)
    
End If

End Sub