macro to take information from. xml file and put it in. xls file

[k0st4din]

Hello to all
over a week ago I made a request for some help with a macro, but so far I have no answer. Therefore I beg you if someone is able to help me with it ( because you have to change a little , but I do not know how to do it)
First I do not know how to change what has to change in order to be elected even din file (because it is currently allows open ( only reach a certain folder) that contains the .xml file)
The second error is that as the macro stops and does not want to copy the information and put it in my main file.
Thank you in advance for providing help on your part.
Really is very important that macro
Asking did in this forum

Sub ImportXMLData()
Application.ScreenUpdating = False
'declaring variables for sub
Dim strFolder As String, strFile As String
Dim xlWkbk As Workbook, xmlFile As Workbook, LastRow As Long
'calling function to open folder and browse for directory
strFolder = GetFolder
'if folder is empty close the sub
If strFolder = "" Then Exit Sub
'indicates browsing for xml files in the selected directory
strFile = Dir(strFolder & "\*.xml", vbNormal)
'set the excel sheet as the active one
Set xlWkbk = ActiveWorkbook
'loop procedure for all files in folder
While strFile <> ""
  LastRow = xlWkbk.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row + 1
  Set xmlFile = Workbooks.OpenXML(Filename:=strFolder & "\" & strFile, LoadOption:=xlXmlLoadImportToList)
    xmlFile.Sheets(1).UsedRange.Copy
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    xlWkbk.Sheets(1).Range("A" & LastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    strFile = Dir()
Wend
Set xmlFile = Nothing: Set xlWkbk = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[k0st4din]

Hello to all
please if there is anything you do not understand ask me.
Is there anyone who can help me to work this macro. Everything else works in my file only this macro can not fix it.
Thank you very much for the responsiveness

[mancubus]

hi there.

the code you posted was taken from: http://www.msofficeforums.com/excel-...xml-files.html

including a link to the original code's web page in your code will be a good practice.

the poster is "macropod" who is also a member of this forum.

[mancubus]

btw, i dont understand what you are trying to do.

reading your thread at mrexcel makes me think you want to select a single xml file to copy data from.

is that right?

[k0st4din]

Hello mancubus
sorry I did not post the link where I found this macro.
I'll do it immediately, but not so as you type it and I had not come across in the display on the forum.
Forum in which after much searching I found this macro is this: http://www.excelforum.com/excel-prog...-workbook.html
Please excuse me again most sincerely on my part.
On the issue of macro: Once I found it I decided to try if it works for me and the first is to - I want to pick a certain person (.xml) file, not all files in the folder (ie at the time the macro is designed I can not come to the files only to the folder in which they are located)
The second thing is a mistake - open (.xml) file and the macro stops - ie do not transfer information in my main file.

Thank you once again for your cooperation.

[mancubus]

you are welcome.

below works for me for a single xml file.

ThisWorkbook refers to the workbook that contains the macro.

Sub ImportXMLFile()
     
     Dim fName As String
     
     Application.DisplayAlerts = False
     
     fName = "D:\My Documents\MailItems.xml" 'Change full file name to suit
     Workbooks.OpenXML Filename:=fName, LoadOption:=xlXmlLoadImportToList
     
     With ActiveWorkbook
        .Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
        .Close False
     End With

End Sub

[k0st4din]

Thank you very much, but I have only one question - how to remove exactly where to look, and put to open a standard window in which I can navigate and access the desired file?
To remove this:

fName = "D:\My Documents\MailItems.xml"

And put something like (type)

strFile = Dir(strFolder & "\*.xml", vbNormal)

Because this file I sit on different computers in my clients and their sales drop off.

[mancubus]

Sub ImportXMLFile()
     
    Dim fName As Variant
     
    Application.DisplayAlerts = False
     
    fName = Application.GetOpenFilename(FileFilter:="XML Files (*.xml),*.xml")
    If fName = False Then
        MsgBox "Please select the xml file to open." & vbLf & _
        "Quitting..."
        Exit Sub
    End If
    
    Workbooks.OpenXML Filename:=fName, LoadOption:=xlXmlLoadImportToList
    With ActiveWorkbook
        .Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
        .Close False
    End With
    
End Sub