用VBA读取Excel表格输出到格式化的xml文件中

最近需要做一个一劳永逸的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://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba

http://stackoverflow.com/questions/31435662/vba-save-a-file-with-utf-8-without-bom

http://stackoverflow.com/questions/4143524/can-i-export-excel-data-with-utf-8-without-bom

http://www.tutorialspoint.com/vba/vba_text_files.htm