加快vba宏以在删除连接和xmlmap的同时将xml数据导入到Excel工作簿中

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 ...