[英]Rows are repeating for a single XML in Excel using VBA
I am suing the below macro that I found on the net to extract the data from XML to Excel. 我正在网上寻找以下宏,以将数据从XML提取到Excel。
Sub ListFiles()
'LISTFILES AND LISTMYFILES MODIFIED FROM
'--------------------------------------------------------------------
'DECLARE AND SET VARIABLEs
Dim ShellApplication As Object
Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
Path = ShellApplication.self.Path
Set ShellApplication = Nothing
[a3] = "XML"
[b3] = "Files"
'--------------------------------------------------------------------
'DEFAULT PATH FROM HIDDEN SHEET
Call ListMyFiles(Path, True)
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
'With SearchXML
Application.ScreenUpdating = False
'--------------------------------------------------------------------
'FIND XML FILES ONLY, APPLY SEARCH CRIERIA, DISPLAY MATCHES ONLY
For Each myfile In mySource.Files
If Right(myfile.Name, 3) = "XML" Or Right(myfile.Name, 3) = "xml" Then 'IS XML?
LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'-------------------------------------------------------------
'IMPORT XML FILE
ActiveWorkbook.XmlImport URL:=mySource & "\" & myfile.Name, _
ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$" & LastRow + 1)
'------------------------------------------------------------
'DELETE MAPS
maps = ActiveWorkbook.XmlMaps.Count
For I = 1 To maps
ActiveWorkbook.XmlMaps(1).Delete
Next I
End If
Next
If IncludeSubfolders Then 'SEARCH SUBFOLDERS FOR SAME CRITERIA
For Each MySubFolder In mySource.SubFolders
Call ListMyFiles(MySubFolder.Path, True)
Next
End If
'End With
Application.ScreenUpdating = True
End Sub
Public Sub ClearSheet()
Cells.Select
Selection.ClearContents
[a1].Select
End Sub
However, it is generating multiple rows for some XMLs, but I want a single row for a single XML. 但是,它为某些XML生成多行,但是我希望为单个XML生成一行。
It may depend on the XML that you import, but there is a part that may need correction : 它可能取决于您导入的XML,但是有些部分可能需要更正:
maps = ActiveWorkbook.XmlMaps.Count
For I = 1 To maps
ActiveWorkbook.XmlMaps(1).Delete
Next I
You should go through it backward, by adding Step -1
您应该向后浏览,添加
Step -1
maps = ActiveWorkbook.XmlMaps.Count
For i = 1 To maps Step -1
ActiveWorkbook.XmlMaps(i).Delete
Next i
Hope that helped! 希望能有所帮助! ;)
;)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.