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

 1 Sub WriteToXml()
 2   
 3   Dim FilePath As String
 4   Dim ClientID As String
 5   Dim Name As String
 6   Dim LastCol As Long
 7   Dim LastRow As Long
 8   
 9   Dim fso As FileSystemObject
10   Set fso = New FileSystemObject
11   
12   Dim fst As Object
13   Set fst = CreateObject("ADODB.Stream")
14   
15   
16   
17   
18   Dim stream As TextStream
19   
20   LastCol = ActiveSheet.UsedRange.Columns.Count
21   LastRow = ActiveSheet.UsedRange.Rows.Count
22     
23   ‘ Create a TextStream.
24   
25  ‘ Set stream = fso.OpenTextFile("D:\ClientConfig.xml", ForWriting, True)
26   
27   fst.Type = 2 ‘Specify stream type - we want To save text/string data.
28   fst.Charset = "utf-8" ‘Specify charset For the source text data.
29   fst.Open ‘Open the stream And write binary data To the object
30  
31   
32   ‘stream.WriteLine "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>"
33   ‘stream.WriteLine "<config>"
34   ‘stream.WriteLine "  <clients>"
35  
36   fst.WriteText "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>" & Chr(10)
37   fst.WriteText "<config>" & Chr(10)
38   fst.WriteText "  <clients>" & Chr(10)
39   
40   CellData = ""
41   
42   For Row = 1 To LastRow
43       
44       ClientID = Cells(Row, 1).Value
45       Name = Cells(Row, 2).Value
46       
47      ‘ stream.WriteLine "    <client clientid=" & Chr(34) & ClientID & Chr(34) & " name=" & Chr(34) & Name & Chr(34) & _
48      ‘ " ip=" & Chr(34) & Chr(34) & " username=" & Chr(34) & "username" & Chr(34) & " password=" & Chr(34) & "password" & Chr(34) & _
49      ‘ " upload=" & Chr(34) & "yes" & Chr(34) & " cachedvalidtime=" & Chr(34) & "172800" & Chr(34) & ">"
50       
51       ‘stream.WriteLine "         <grid savepath=" & Chr(34) & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr(34) & _
52       ‘" filename=" & Chr(34) & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr(34) & " >" & "</grid>"
53       
54       ‘stream.WriteLine "    </client>"
55       
56      fst.WriteText "    <client clientid=" & Chr(34) & ClientID & Chr(34) & " name=" & Chr(34) & Name & Chr(34) & _
57       " ip=" & Chr(34) & Chr(34) & " username=" & Chr(34) & "username" & Chr(34) & " password=" & Chr(34) & "password" & Chr(34) & _
58       " upload=" & Chr(34) & "yes" & Chr(34) & " cachedvalidtime=" & Chr(34) & "172800" & Chr(34) & ">" & Chr(10)
59       
60       fst.WriteText "         <grid savepath=" & Chr(34) & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr(34) & _
61       " filename=" & Chr(34) & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr(34) & " >" & "</grid>" & Chr(10)
62       
63      fst.WriteText "    </client>" & Chr(10)
64   
65   Next Row
66   
67   
68  ‘ stream.WriteLine "  </clients>"
69  ‘ stream.WriteLine "</config>"
70  ‘ stream.Close
71 
72   fst.WriteText "  </clients>" & Chr(10)
73   fst.WriteText "</config>" & Chr(10)
74  
75   fst.SaveToFile "D:\ClientConfig.xml", 2 ‘Save binary data To disk
76   MsgBox ("Job Done")
77 End Sub