最近需要做一个一劳永逸的XML文档生成，给项目内部专用的，直接VBA方便了，才第一次用。现学现卖了。。。。抽时间还是系统的学习下这方面的知识吧
输出到UTF-8编码的XML文档。并且换行符是Unix的\n换行符。
Sub WriteToXml() Dim FilePath As String
Dim ClientID As String
Dim Name As String
Dim LastCol As Long
Dim LastRow As Long Dim fso As FileSystemObject
Set fso = New FileSystemObject Dim fst As Object
Set fst = CreateObject("ADODB.Stream") Dim stream As TextStream LastCol = ActiveSheet.UsedRange.Columns.Count
LastRow = ActiveSheet.UsedRange.Rows.Count ' Create a TextStream. ' Set stream = fso.OpenTextFile("D:\ClientConfig.xml", ForWriting, True) fst.Type = 'Specify stream type - we want To save text/string data.
fst.Charset = "utf-8" 'Specify charset For the source text data.
fst.Open 'Open the stream And write binary data To the object 'stream.WriteLine "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>"
'stream.WriteLine "<config>"
'stream.WriteLine " <clients>" fst.WriteText "<?xml version=" & Chr() & "1.0" & Chr() & " encoding=" & Chr() & "utf-8" & Chr() & "?>" & Chr()
fst.WriteText "<config>" & Chr()
fst.WriteText " <clients>" & Chr() CellData = "" For Row = To LastRow ClientID = Cells(Row, ).Value
Name = Cells(Row, ).Value ' stream.WriteLine " <client clientid=" & Chr(34) & ClientID & Chr(34) & " name=" & Chr(34) & Name & Chr(34) & _
' " ip=" & Chr(34) & Chr(34) & " username=" & Chr(34) & "username" & Chr(34) & " password=" & Chr(34) & "password" & Chr(34) & _
' " upload=" & Chr(34) & "yes" & Chr(34) & " cachedvalidtime=" & Chr(34) & "172800" & Chr(34) & ">" 'stream.WriteLine " <grid savepath=" & Chr(34) & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr(34) & _
'" filename=" & Chr(34) & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr(34) & " >" & "</grid>" 'stream.WriteLine " </client>" fst.WriteText " <client clientid=" & Chr() & ClientID & Chr() & " name=" & Chr() & Name & Chr() & _
" ip=" & Chr() & Chr() & " username=" & Chr() & "username" & Chr() & " password=" & Chr() & "password" & Chr() & _
" upload=" & Chr() & "yes" & Chr() & " cachedvalidtime=" & Chr() & "" & Chr() & ">" & Chr() fst.WriteText " <grid savepath=" & Chr() & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr() & _
" filename=" & Chr() & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr() & " >" & "</grid>" & Chr() fst.WriteText " </client>" & Chr() Next Row ' stream.WriteLine " </clients>"
' stream.WriteLine "</config>"
' stream.Close fst.WriteText " </clients>" & Chr()
fst.WriteText "</config>" & Chr() fst.SaveToFile "D:\ClientConfig.xml", 'Save binary data To disk
MsgBox ("Job Done")
End Sub
以下是一个根据需求的代码调整：
Sub Process()
Dim FilePath As String
Dim ClientID As String
Dim Name As String
Dim LastCol As Long
Dim LastRow As Long Dim IDPreffix As String Dim fst As Object
Set fst = CreateObject("ADODB.Stream") Dim oldIDPreffix As String
Dim oldName As String LastCol = ActiveSheet.UsedRange.Columns.Count
LastRow = ActiveSheet.UsedRange.Rows.Count For Row = To LastRow
ClientID = Cells(Row, ).Value
Name = Cells(Row, ).Value If Row = Then
oldIDPreffix = Mid(ClientID, , )
oldName = Name
'打开流
fst.Type = 'Specify stream type - we want To save text/string data.
fst.Charset = "utf-8" 'Specify charset For the source text data.
fst.Open 'Open the stream And write binary data To the object fst.WriteText "<?xml version=" & Chr() & "1.0" & Chr() & " encoding=" & Chr() & "utf-8" & Chr() & "?>" & Chr()
fst.WriteText "<config>" & Chr()
fst.WriteText " <clients>" & Chr()
End If IDPreffix = Mid(ClientID, , ) If IDPreffix = oldIDPreffix Then 'write file
fst.WriteText " <client clientid=" & Chr() & ClientID & Chr() & " name=" & Chr() & Name & Chr() & _
" ip=" & Chr() & Chr() & " username=" & Chr() & "username" & Chr() & " password=" & Chr() & "password" & Chr() & _
" upload=" & Chr() & "yes" & Chr() & " cachedvalidtime=" & Chr() & "" & Chr() & ">" & Chr() fst.WriteText " <grid savepath=" & Chr() & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr() & _
" filename=" & Chr() & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr() & " >" & "</grid>" & Chr() fst.WriteText " </client>" & Chr() Else 'write file tail
fst.WriteText " </clients>" & Chr()
fst.WriteText "</config>" & Chr() 'save to file
fst.SaveToFile "D:\" & oldName & "_ClientConfig" & ".xml", 'Save binary data To disk
fst.flush
fst.Close oldIDPreffix = IDPreffix
oldName = Name '打开流
fst.Type = 'Specify stream type - we want To save text/string data.
fst.Charset = "utf-8" 'Specify charset For the source text data.
fst.Open 'Open the stream And write binary data To the object 'write file head
fst.WriteText "<?xml version=" & Chr() & "1.0" & Chr() & " encoding=" & Chr() & "utf-8" & Chr() & "?>" & Chr()
fst.WriteText "<config>" & Chr()
fst.WriteText " <clients>" & Chr() fst.WriteText " <client clientid=" & Chr() & ClientID & Chr() & " name=" & Chr() & Name & Chr() & _
" ip=" & Chr() & Chr() & " username=" & Chr() & "username" & Chr() & " password=" & Chr() & "password" & Chr() & _
" upload=" & Chr() & "yes" & Chr() & " cachedvalidtime=" & Chr() & "" & Chr() & ">" & Chr() fst.WriteText " <grid savepath=" & Chr() & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr() & _
" filename=" & Chr() & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr() & " >" & "</grid>" & Chr() fst.WriteText " </client>" & Chr() End If Next Row MsgBox ("Job Done") End Sub
references：
http://*.com/questions/2524703/save-text-file-utf-8-encoded-with-vba
http://*.com/questions/31435662/vba-save-a-file-with-utf-8-without-bom
http://*.com/questions/4143524/can-i-export-excel-data-with-utf-8-without-bom
http://www.tutorialspoint.com/vba/vba_text_files.htm