用VBA读取Excel表格输出到格式化的xml文件中
2023-09-11 14:19:35 时间
最近需要做一个一劳永逸的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
以下是一个根据需求的代码调整：
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
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
相关文章
- 不依赖Excel是否安装的Excel导入导出类
- POI 导入excel数据自己主动封装成model对象--代码分析
- Excel计算一列的和sum(A:A)
- [转]tableExport.js 导出excel 如果有负数或是空值 导出前面会自动加上单引号
- 一文搞懂Go读写Excel文件
- excel操作手记
- MVC3学习：将excel文件导入到sql server数据库
- Excel VLOOKUP实用教程之 05 vlookup如何从列表中获取最后一个值？（教程含数据excel）
- 使用 Python 和 Streamlit 从 Excel 中进行 VLOOKUP
- 《数据科学：R语言实现》——2.5 使用Excel文件
- excel--CLEAN()函数，解决为什么看着相同的字符串但是len()长度不同
- Excel—在Excel中利用宏定义实现MD5对字符串（如：手机号）或者文件加密
- excel-合并多个Excel文件--VBA合并当前目录下所有Excel工作簿中的所有工作表
- Excel-在整个工作簿中查找/替换
- nodejs获取formdata上传的文件及解析excel问题
- PHP通过phpspreadsheet读取Excel文件
- MVC 导出 EXCEL
- 怀疑前端组件把我的excel文件搞坏了，怎么证明