楼主
kevinchengcw |
Q: 如何利用vba代码批量导入xml文件信息？
A: 代码如下：
- Sub test()
- Dim FN$, N&, I&, LO As ListObject
- Application.ScreenUpdating = False '关闭屏幕刷新及警告信息
- Application.DisplayAlerts = False
- FN = Dir(ThisWorkbook.Path & "\*.xml") '枚举当前工作簿下的xml文件
- N = 1 '初始化起始导入行位置
- I = 0 '初始化申报日期列值为0,方便后期判断处理(因为列值为0是无效的)
- Do While FN <> "" '循环处理各个找到的文件
- ThisWorkbook.XmlImport ThisWorkbook.Path & "\" & FN, Nothing, False, Cells(N, 1) '利用excel自身功能导入xml文件信息
- If I = 0 Then I = Cells(1, Columns.Count).End(1).Offset(, 1).Column '如果申请日期列号为0及将当前表最右方第一个空单元格列号赋给变量
- Range(Cells(N, I), Cells(Rows.Count, I).End(3)) = Right(Split(FN, ".")(0), 6) '向申请日期列当前表格区域写入从文件名中取得的申请日期数据
- N = Cells(Rows.Count, 1).End(3).Offset(1).Row + 1 '取得下一起始行位置(在两表之间空一行,因为有的数据似乎超出空白行范围造成程序出错,两表间空格可以根据需要调整至更大,在后期处理时会清除空白的行)
- For Each LO In ActiveSheet.ListObjects '将当前工作表中的表格转换为区域,以方便进行删除等操作
- LO.Unlist
- Next LO
- FN = Dir '枚举下一个文件
- Loop
- Cells(1, Columns.Count).End(1) = "申报日期" '为申报日期列写入标题
- Columns(1).NumberFormatLocal = "@" '因A列数据长度为15位,故设置成文本格式
- For N = Cells(Rows.Count, 1).End(3).Row To 2 Step -1 '循环删除无效行,并将有效行A列数据转换为文本(防止出现科学计数样式)
- If Cells(N, 1).Value = "SWSBH" Or Cells(N, 1) = "" Then
- Rows(N).Delete
- Else
- Cells(N, 1) = Split(Cells(N, 1).Value, "")(0)
- End If
- Next N
- Columns.AutoFit '自动调整一下列宽
- Application.DisplayAlerts = True '打开警告信息和屏幕刷新
- Application.ScreenUpdating = True
- MsgBox "OK" '显示提示信息
- End Sub
更多方法和信息详见附件及素材源帖.
 Demo.rar
|