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

最近需要做一个一劳永逸的XML文档生成,给项目内部专用的,直接VBA方便了,才第一次用。现学现卖了。。。。抽时间还是系统的学习下这方面的知识吧

 

输出到UTF-8编码的XML文档。并且换行符是Unix的\n换行符。

 

 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
View Code

 

以下是一个根据需求的代码调整:

  1 Sub Process()
  2   Dim FilePath As String
  3   Dim ClientID As String
  4   Dim Name As String
  5   Dim LastCol As Long
  6   Dim LastRow As Long
  7   
  8   Dim IDPreffix As String
  9   
 10   
 11   Dim fst As Object
 12   Set fst = CreateObject("ADODB.Stream")
 13   
 14   
 15   
 16   
 17   Dim oldIDPreffix As String
 18   Dim oldName As String
 19   
 20   LastCol = ActiveSheet.UsedRange.Columns.Count
 21   LastRow = ActiveSheet.UsedRange.Rows.Count
 22   
 23   For Row = 1 To LastRow
 24       ClientID = Cells(Row, 1).Value
 25       Name = Cells(Row, 2).Value
 26       
 27       If Row = 1 Then
 28         oldIDPreffix = Mid(ClientID, 1, 2)
 29         oldName = Name
 30         '打开流
 31          fst.Type = 2 'Specify stream type - we want To save text/string data.
 32          fst.Charset = "utf-8" 'Specify charset For the source text data.
 33          fst.Open 'Open the stream And write binary data To the object
 34          
 35           fst.WriteText "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>" & Chr(10)
 36           fst.WriteText "<config>" & Chr(10)
 37           fst.WriteText "  <clients>" & Chr(10)
 38       End If
 39       
 40       
 41       IDPreffix = Mid(ClientID, 1, 2)
 42       
 43       If IDPreffix = oldIDPreffix Then
 44          
 45             'write file
 46             fst.WriteText "    <client clientid=" & Chr(34) & ClientID & Chr(34) & " name=" & Chr(34) & Name & Chr(34) & _
 47       " ip=" & Chr(34) & Chr(34) & " username=" & Chr(34) & "username" & Chr(34) & " password=" & Chr(34) & "password" & Chr(34) & _
 48       " upload=" & Chr(34) & "yes" & Chr(34) & " cachedvalidtime=" & Chr(34) & "172800" & Chr(34) & ">" & Chr(10)
 49       
 50            fst.WriteText "         <grid savepath=" & Chr(34) & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr(34) & _
 51       " filename=" & Chr(34) & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr(34) & " >" & "</grid>" & Chr(10)
 52       
 53           fst.WriteText "    </client>" & Chr(10)
 54       
 55       Else
 56       
 57          'write file tail
 58          fst.WriteText "  </clients>" & Chr(10)
 59          fst.WriteText "</config>" & Chr(10)
 60          
 61          'save to file
 62          fst.SaveToFile "D:\" & oldName & "_ClientConfig" & ".xml", 2 'Save binary data To disk
 63          fst.flush
 64          fst.Close
 65          
 66          oldIDPreffix = IDPreffix
 67          oldName = Name
 68          
 69          '打开流
 70          fst.Type = 2 'Specify stream type - we want To save text/string data.
 71          fst.Charset = "utf-8" 'Specify charset For the source text data.
 72          fst.Open 'Open the stream And write binary data To the object
 73          
 74           'write file head
 75           fst.WriteText "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>" & Chr(10)
 76           fst.WriteText "<config>" & Chr(10)
 77           fst.WriteText "  <clients>" & Chr(10)
 78           
 79           fst.WriteText "    <client clientid=" & Chr(34) & ClientID & Chr(34) & " name=" & Chr(34) & Name & Chr(34) & _
 80       " ip=" & Chr(34) & Chr(34) & " username=" & Chr(34) & "username" & Chr(34) & " password=" & Chr(34) & "password" & Chr(34) & _
 81       " upload=" & Chr(34) & "yes" & Chr(34) & " cachedvalidtime=" & Chr(34) & "172800" & Chr(34) & ">" & Chr(10)
 82       
 83            fst.WriteText "         <grid savepath=" & Chr(34) & "/data/lwfd/client/{CLIENTID}/{TYPE}/{YYYYMMDD}" & Chr(34) & _
 84       " filename=" & Chr(34) & "{TYPE}_{CCC}_{YYYYMMDDHH}_{FFF}_{TT}.grib2" & Chr(34) & " >" & "</grid>" & Chr(10)
 85       
 86           fst.WriteText "    </client>" & Chr(10)
 87          
 88          
 89       
 90       End If
 91       
 92   
 93   
 94   
 95   Next Row
 96   
 97   MsgBox ("Job Done")
 98   
 99   
100 End Sub
View Code

 

 

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

相关推荐

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值