Question

我目前使用以下vba将12000多个xml文件导入excel工作簿：

Public Sub XMLIMport()

    Dim lngRow As Long
    Dim strXML As String
    Dim ct As Integer, XMLMap

    Const maxXMLDel = 1
    lngRow = 2

    Do While Cells(lngRow, 1) <> ""
        strXML = Cells(lngRow, 1)
        ActiveWorkbook.XMLIMport url:=strXML, _
        ImportMap:=Nothing, Overwrite:=False, _
        Destination:=Range("$B$" & lngRow)
        lngRow = lngRow + 1
        For Each XMLMap In ActiveWorkbook.XmlMaps
                  XMLMap.Delete
        Next
    Loop

End Sub

然后继续将excel中的工作簿表导入Access 2007中的表。导入使用指向服务器的链接来下载单个文件。

因此，在列A中是xml链接，并且宏将xml数据结果放在列B，C，D等中，然后继续到下一行并为每个文件重复该过程。但是有这么多文件需要相当长的时间才能完成这个过程。我甚至包括删除xml地图以加快进程，但Excel 2007仍需要很长时间才能完成该过程（2小时+）。

这个宏我猜是因为缺少一个更好的单词'优化'来满足我的需求，还是有另外一种方法可以做到这一点？

更新：禁用屏幕更新，但在尝试删除连接时遇到错误。

运行宏录制器我得到以下内容来删除一些连接，但我不确定如何将其添加到上面的宏中，以便在继续下一个文件之前删除除xmlmap之外的连接。

Sub deleteconnection()
'
' deleteconnection Macro
'

'
    ActiveWorkbook.Connections("itemResponse").Delete
    ActiveWorkbook.Connections("itemResponse1").Delete
    ActiveWorkbook.Connections("itemResponse10").Delete
    ActiveWorkbook.Connections("itemResponse100").Delete
    ActiveWorkbook.Connections("itemResponse101").Delete
    ActiveWorkbook.Connections("itemResponse102").Delete
    ActiveWorkbook.Connections("itemResponse103").Delete
    ActiveWorkbook.Connections("itemResponse104").Delete
    ActiveWorkbook.Connections("itemResponse105").Delete
    ActiveWorkbook.Connections("itemResponse106").Delete
    ActiveWorkbook.Connections("itemResponse107").Delete
    ActiveWorkbook.Connections("itemResponse108").Delete
    ActiveWorkbook.Connections("itemResponse109").Delete
    ActiveWorkbook.Connections("itemResponse11").Delete
    ActiveWorkbook.Connections("itemResponse110").Delete
    ActiveWorkbook.Connections("itemResponse111").Delete
    ActiveWorkbook.Connections("itemResponse112").Delete
    ActiveWorkbook.Connections("itemResponse113").Delete
    ActiveWorkbook.Connections("itemResponse114").Delete
    ActiveWorkbook.Connections("itemResponse115").Delete
    ActiveWorkbook.Connections("itemResponse116").Delete
    ActiveWorkbook.Connections("itemResponse117").Delete
    ActiveWorkbook.Connections("itemResponse118").Delete
    ActiveWorkbook.Connections("itemResponse119").Delete

End Sub

编辑：尝试使用以下

为连接添加删除

Public Sub XMLIMport()

    Dim lngRow As Long
    Dim strXML As String
    Dim ct As Integer, XMLMap
    Dim QTable As QueryTables


    'Application.ScreenUpdating = False

    Const maxXMLDel = 1
    lngRow = 2

    Do While Cells(lngRow, 1) <> ""
        strXML = Cells(lngRow, 1)
        ActiveWorkbook.XMLIMport url:=strXML, ImportMap:=Nothing, Overwrite:=False, Destination:=Range("$B$" & lngRow)
        lngRow = lngRow + 1
        For Each XMLMap In ActiveWorkbook.XmlMaps
                  XMLMap.Delete
         Next
         For Each QTable In ActiveSheet.QueryTables
                  QTable.Delete

         Next
    Loop

    'Application.ScreenUpdating = True

End Sub

导致连接仍保留在工作簿中，并重新插入第一个文件

Answer 1

删除所有连接：

Dim Conn As Object        '* connection collection

For Each Conn In ActiveWorkbook.Connections

    Conn.Delete

Next Conn

Answer 2

要提高大型表的慢速XMLmap导入性能，请在导入之前调整ListObject的范围大小。

从60秒开始，导入60'000条记录x 10个字段

lst.XmlMap.Import "c:\data\dummy.xml"

在5秒以下：

lst.Resize lst.Range.Resize(data.count)
lst.XmlMap.Import "c:\data\dummy.xml"

因此在导入之前对项目进行计数确实值得。我认为性能差距是由于excel在导入期间分别插入每一行所致。可能您已经具有行数，否则您可以在DomDocument中使用SelectNodes（x）.length。或使用element（x）.Descendents（y）.Count ...

加速vba宏以将xml数据导入excel工作簿，同时删除连接和xmlmaps

2 个答案: