使用vba将多个xml自动化为excel

时间:2013-10-18 21:25:31

标签: xml excel vba excel-vba converter

好的,开始:我是一个完整的VBA傻瓜。我一直试图破解这段代码几个小时,我认为进一步了解vba如何工作的最好方法就是召集部队。我希望没有人被这个冒犯。

这就是我想要做的: a)逐个打开文件夹中的所有xml文件 b)将它们转换为excel文件 c)然后将它们一个一个地保存为另一个文件夹中的excel文件

我到目前为止的代码如下:

Sub xmltoxl()
Dim fs As FileSearch
Dim i As Integer
Dim wbk As Workbook
Dim s As Integer

Set fs = Application.FileSearch

With fs
    .LookIn = ThisWorkbook.Path
    .Filename = "*.xml"
    For i = 1 To .Execute()
        Set wbk = Workbooks.OpenXML(.FoundFiles(i))
        s = 1
   ChDir "C:\Users\Seeb\Desktop\Volkskrant\2013_archiefb"
    ActiveWorkbook.SaveAs Filename: (s & ".xls")
    s = s + 1
    Next i
End With

End Sub

2 个答案:

答案 0 :(得分:2)

未测试:

Sub xmltoxl()
Dim f As String
Dim wbk As Workbook
Dim s As Integer

f = Dir(ThisWorkbook.Path & "\*.xml")
s = 0

Do While Len(f)>0
    s = s + 1
    Set wbk = Workbooks.OpenXML(ThisWorkbook.Path & "\" & f)
    wbk.SaveAs Filename:="C:\Users\Seeb\Desktop\Volkskrant\2013_archiefb" & s & ".xls"
    wbk.Close False
    f = Dir() 
Loop


End Sub

答案 1 :(得分:0)

有一些变化,是的,它有效。至少,中途通过(我将重做下半场)。谢谢蒂姆。

Sub xmltoxl()
Dim f As String
Dim wbk As Workbook
Dim s As Integer

f = Dir("C:\Users\Seeb\Desktop\Volkskrant\2013_archief" & "\*.xml")
s = 0

Do While Len(f) > 0
    s = s + 1
    Set wbk = Workbooks.OpenXML("C:\Users\Seeb\Desktop\Volkskrant\2013_archief" & "\" & f)
    wbk.SaveAs Filename:="C:\Users\Seeb\Desktop\Volkskrant\2013_archiefb\" & s & ".xls"
    wbk.Close False
    f = Dir()
Loop

End Sub