I have written some vbaVBA to loop through a directory of 15,000 XML files and extract key information from these files into Excel - this is unbearably slow. Can someone please assist me in optimising the module?
Sub ImportXMLtoList()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Dim myDir As String
Dim StrFile As String
StrFile = Dir("\\Ntsydfsp152\shared\Temp\Lucsan\LMIG\Output\XML\SBL\Staging\")
myDir = "\\Ntsydfsp152\shared\Temp\Lucsan\LMIG\Output\XML\SBL\Staging\"
myFile = "LMIG_List_XML_Files.xlsm"
'clear sheet1
Sheets(1).Range("a2:g30000").Clear
x = 2
Do While Len(StrFile) > 0
Application.StatusBar = StrFile & " Row: " & x
Sheets(1).Cells(x, 1).Value = StrFile
Workbooks.OpenXML Filename:=myDir & StrFile, LoadOption:=xlXmlLoadImportToList
temp2 = ActiveWorkbook.Sheets(1).Range("g2")
temp3 = ActiveWorkbook.Sheets(1).Range("e2")
temp4 = ActiveWorkbook.Sheets(1).Range("ak3")
temp5 = ActiveWorkbook.Sheets(1).Range("av4") & "/" & ActiveWorkbook.Sheets(1).Range("ax4") & "/" & ActiveWorkbook.Sheets(1).Range("aw4") & "/" & ActiveWorkbook.Sheets(1).Range("ay4")
ActiveWorkbook.Close
Sheets(1).Cells(x, 2) = temp2
Sheets(1).Cells(x, 3) = temp3
Sheets(1).Cells(x, 4) = temp4
Sheets(1).Cells(x, 5) = temp5
x = x + 1
StrFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End Sub
