Question

I currently import 12000+ xml files into an excel workbook using the following vba:

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

and then proceed to import the workbook sheet from excel into a table in access 2007. The import uses links to the server to download the individual files.

So in column A is the xml link and the macro places the xml data results in columns B, C, D, etc and proceeds to the next row and repeats the process for each file. But with so many files it takes quite some time before the process is finished. I have even included deleting xml maps to speed up the process, but Excel 2007 still takes quite awhile to finish the process (2hrs+).

Is this macro I guess for lack of a better word ‘optimized’ for what I am wanting or is there another way this should be done?

UPDATE: disabled screen updating but running into an error trying to delete the connections.

running the macro recorder I get the following for deleting some of the connections, but I am unsure how to add this to the above macro to make it delete the connection in addition to the xmlmap before proceeding to the next file.

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

EDIT: Trying to adding a deletion for connections using the following

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

results in the connections being still left in the workbook and the first file is reinserted

Answer 1

To delete all connections:

Dim Conn As Object        '* connection collection

For Each Conn In ActiveWorkbook.Connections

    Conn.Delete

Next Conn