PDA

View Full Version : [SOLVED] macro to take information from. xml file and put it in. xls file



k0st4din
05-22-2014, 10:10 PM
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 (http://www.mrexcel.com/forum/excel-questions/777060-macro-take-information-xml-file-put-xls-file.html)

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
05-26-2014, 09:12 PM
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
05-27-2014, 01:45 PM
hi there.

the code you posted was taken from: http://www.msofficeforums.com/excel-programming/11991-import-multiple-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
05-27-2014, 01:49 PM
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
05-27-2014, 09:33 PM
Hello mancubus (http://www.vbaexpress.com/forum/member.php?37987-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-programming-vba-macros/940028-vb-to-paste-xml-contents-of-several-files-to-one-excel-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
05-28-2014, 01:07 AM
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
05-28-2014, 09:00 AM
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
05-28-2014, 09:34 AM
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