# Solved: VBA to import multiple XML Files



## johnsmith1758 (Aug 10, 2006)

Hi all,

I have a problem with importing a number of XML Files into an Excel spreadsheet (Excel 2007) for data analysis purposes. Essentially, I going to be recieving a number of XML files each week, which I'll need to import and carry out some simple analysis upon. The number and file name of the XML files that I'll recieve will be variable and difficult to predict (but it's safe to assume that the number is normally going to be in the thousands!), but they will all be deposited in the same folder until processing has been completed.

I have written a quick macro that interrogates the folder that I'll use to store the data, and returns the file names of the XML files in a list in Column A to sheet called, cleverly, "Files".

The next part is where I'm struggling. I would like to import the data from each of the files listed, row by row (starting in row 2), into another sheet, "XML Data".

Because of the variable number and name of the files, I don't want to hard-code the name of the files into the macro. I thought this might be avoidable as I already have a function to create a list of the files that I'm interested in, but I can't seem to get my head around it!

Any help you can provide would be much appreciated.

Many thanks


----------



## johnsmith1758 (Aug 10, 2006)

All,

I've found a solution that seems to work. In case anybody is interested, I've used the following code:

Sub Batch_XML_Import()
On Error GoTo errh
Dim myWB As Workbook, WB As Workbook
Set myWB = ThisWorkbook
Dim myPath
myPath = "C:\Folder 1\Folder 2\Received XML Data\" '<<< change path
Dim myFile
myFile = Dir(myPath & "*.xml")
Dim t As Long, N As Long, r As Long, c As Long
t = 1
N = 0

Application.ScreenUpdating = False
Do While myFile <> ""
N = N + 1
Set WB = Workbooks.OpenXML(Filename:=myPath & myFile)
If N > 1 Then
r = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
c = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
WB.Sheets(1).Range(Cells(3, "A"), Cells(r, c)).Copy myWB.Sheets("XML Data").Cells(t, "A")
Else
WB.Sheets(1).UsedRange.Copy myWB.Sheets("XML Data").Cells(t, "A")
End If
WB.Close False
t = myWB.Sheets("XML Data").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
myFile = Dir()
Loop
Application.ScreenUpdating = True
myWB.Save
Exit Sub
errh:
MsgBox "no files xml"
End Sub

Thanks


----------

