Link to home
Start Free TrialLog in
Avatar of nainil
nainilFlag for United States of America

asked on

Open XML files in Excel

I have a folder full of XML files. I need to read the XML files and save them in Excel.

chikeysitems28<CODE>.xml
chiparameters28<CODE>.xml
chisegmentdetails28<CODE>.xml

Where <CODE> could be any text, no fixed length. However, the initial part of the file names is always going to be the same. I use the MID function to extract the CODE.

Files with the same <CODE> need to go under the same sheet.

For eg:

chikeysitems28BUNZ.xml
chiparameters28BUNZ.xml
chisegmentdetails28BUNZ.xml

Above three files should go under a sheet named BUNZ.

chikeysitems28MADL.xml
chiparameters28MADL.xml

Above two files should go under a sheet named MADL.

and so on.

Attached is the code snippet I am using till now...
 
Sub LoopFiles2()

    Static MyFileName, MyPath As String
    Dim sheetname As String
    Dim FileType As Integer
    
    
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            Exit Sub
        Else
            MyPath = .SelectedItems(1) & "\"
        End If
    End With

    MyFileName = Dir(MyPath & "*.xml")
    
    Application.DisplayAlerts = False
    
    Do While Len(MyFileName) > 0
    
        chksheetname = LCase(Mid$(MyFileName, 14))
        
        If chksheetname = "chikeysitems28" Then
            FileType = 1
            sheetname = Split(Mid$(MyFileName, 14), ".")(0)
        Else
        
        chksheetname = LCase(Mid$(MyFileName, 16))
        
            If chksheetname = "chiparameters28" Then
                
                sheetname = Split(Mid$(MyFileName, 16), ".")(0)
                FileType = 2
            Else
                FileType = 3
                
                sheetname = Split(Mid$(MyFileName, 20), ".")(0)
                
            End If
        
        End If
    
        With Sheets.Add

            .Name = sheetname
            
            With .QueryTables.Add(Connection:= _
                                 "FINDER;" & MyPath & MyFileName, _
                                  Destination:=.Range("A1"))
                .Name = .Parent.Name

            End With
            ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
                                   ImportMap:=Nothing, _
                                   Overwrite:=True, _
                                   Destination:=.Range("A1")
        End With
        MyFileName = Dir
    Loop
    
    Application.DisplayAlerts = True
End Sub

Open in new window


Also, I am attaching a few sample files to process.

Any help is appreciated.
test.zip
ASKER CERTIFIED SOLUTION
Avatar of MeLindaJohnson
MeLindaJohnson
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of nainil

ASKER

Thank you MeLindaJohnson. however, I am tied to use excel only.
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of nainil

ASKER

Finally got it working with the attached code. Thank you for your time and patience.
Sub LoopFiles2()

    Static MyFileName, MyPath As String
    Dim sheetname As String
    Dim FileType As Integer
    Dim FINALSHEETNAME As String
    Dim lastrownumber As Long
    
    
   lastrownumer = 0
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            Exit Sub
        Else
            MyPath = .SelectedItems(1) & "\"
        End If
    End With

    MyFileName = Dir(MyPath & "*.xml")
    
    Application.DisplayAlerts = False
    
    Do While Len(MyFileName) > 0
    
         chksheetname = LCase(Left(MyFileName, 13))
                         
        If chksheetname = "chkkeysitem28" Then
            sheetname = Split(Mid$(MyFileName, 14), ".")(0)
            mysheetname = vLookup(sheetname)
        Else
        
        chksheetname = LCase(Left(MyFileName, 15))
        
            If chksheetname = "modparameters28" Then                
                sheetname = Split(Mid$(MyFileName, 16), ".")(0)
                mysheetname = vLookup(sheetname)
            Else
		chksheetname = LCase(Left(MyFileName, 19))
                sheetname = Split(Mid$(MyFileName, 20), ".")(0)
                mysheetname = vLookup(sheetname)
            End If
        
        End If
    
    FINALSHEETNAME = mysheetname
    
    'check if sheet exists
    
    If WorksheetExists(FINALSHEETNAME) Then
        Sheets(FINALSHEETNAME).Activate
        
        'calculate last available row
        lastrownumber = Range("A" & Rows.Count).End(xlUp).Row
                
        lastrownumber = lastrownumber + 2        

	If (IsEmpty(Range("A" & lastrownumber))) Then
            Range("A" & lastrownumber).Value = chksheetname
            
            ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
                                   ImportMap:=Nothing, _
                                   Overwrite:=True, _
                                   Destination:=("A" & lastrownumber + 1)
        End If
        MyFileName = Dir
    Else
        With Sheets.Add

            .Name = FINALSHEETNAME
            
            Range("A1").Value = FINALSHEETNAME
            Range("A3").Value = chksheetname
            
            ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
                                   ImportMap:=Nothing, _
                                   Overwrite:=True, _
                                   Destination:=.Range("A4")
        End With
        MyFileName = Dir
    
    End If

    Loop
    
    Application.DisplayAlerts = True
End Sub


Function vLookup(cd As String) As String

'
' vLookup function
'
Dim lookFor As String
Dim rng As Range
Dim col As Integer
Dim found As Variant

lookFor = cd
Set rng = Sheets("master").Columns("G:H")
col = 2

On Error Resume Next
found = Application.vLookup(lookFor, rng, col, 0)
If IsError(found) Then
    MsgBox lookFor & " not found"
    
Else:
vLookup = found

End If
On Error GoTo 0

'
End Function

Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

Open in new window

Nainil - Thanks for the code.

Solved an issue I had with importing XML

:-)