在Excel中打开一个Xml表格

问题描述：

我查了几个教程和类似的问题，但是我无法解决我的问题。在Excel中打开一个Xml表格

我可以做我所需要的，但这个选项打开一个新的工作簿，然后将所有内容复制到macros.xlsm表Lote。

如何直接在具有宏的Excel工作簿上执行此操作。

Sub Import1() 

Dim wb As Workbook 
Dim TheFile As String 
Dim instance As XPath 
Dim Map As XmlMap 
Dim XPath As String 
Dim Book As String 
Dim clipboard As MSForms.DataObject 

Set clipboard = New MSForms.DataObject 

clipboard.SetText "" 
clipboard.PutInClipboard 

ChDir "C:\rwindows" 

TheFile = Application _ 
.GetOpenFilename("XML Files (*.xml), *.xml", , "Import XML", , False) 

Set wb = Workbooks.OpenXML(Filename:=TheFile, LoadOption:=xlXmlLoadImportToList) 

With ActiveWorkbook.XmlMaps("evs_rpb_Mapa") 
    .ShowImportExportValidationErrors = False 
    .AdjustColumnWidth = True 
    .PreserveColumnFilter = True 
    .PreserveNumberFormatting = True 
    .AppendOnImport = True 
End With 

fileToOpen = Application _ 
.GetOpenFilename("XML Files (*.xml), *.xml", , "Import XML", , True) 

Application.DisplayAlerts = False 
If IsArray(fileToOpen) Then 
    For Each fil In fileToOpen 
     ActiveWorkbook.XmlMaps("evs_rpb_Mapa").Import URL:=fil 
    Next fil 
Else 
    Exit Sub 
End If 

Book = ActiveWindow.Caption 
'Windows("Livro1").Activate 
Windows(Book).Activate 
Columns("A:AL").Select 
Selection.Copy 
Windows("Macros.xlsm").Activate 
Columns("A:AL").Select 
ActiveSheet.Paste 
Windows(Book).Activate 
ActiveWindow.Close 
Columns("A:AL").Select 

Set clipboard = New MSForms.DataObject 

clipboard.SetText "" 
clipboard.PutInClipboard 

Application.DisplayAlerts = True 

End Sub

欢迎StackOverflow上。这会让你熟悉如何提出一个问题：http://stackoverflow.com/help/how-to-ask –

请发布示例XML，以显示如何构建XmlMap并将XML数据反复追加到它。 – Parfait

我无法添加xml文件，我没有该公司的许可。我编辑代码，现在我只需要在macros.xlsm中执行此操作，而不是在其他工作簿中执行此操作，然后复制所有信息 –

答

考虑从一个文件夹选择对话框中选择XML文件的文件夹，然后使用循环反复导入到个XML一张地图：

Sub XMLImport() 
On Error GoTo ErrHandle 
    Dim folderToOpen As Variant, fil As Variant 
    Dim folderDialog As FileDialog 

    Application.DisplayAlerts = False 

    ' RETRIEVE XML FOLDER 
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker) 

    With folderDialog 
     .AllowMultiSelect = False 
     If .Show = -1 Then 
      folderToOpen = folderDialog.SelectedItems(1) & "\" 
     Else 
      MsgBox "No folder selected.", vbExclamation, "NO FOLDER" 
      Exit Sub 
     End If 
    End With 

    ' SET XML MAP SETTINGS 
    ChDir "C:\rwindows" 
    With ActiveWorkbook.XmlMaps("evs_rpb_Mapa") 
     .ShowImportExportValidationErrors = False 
     .AdjustColumnWidth = True 
     .PreserveColumnFilter = True 
     .PreserveNumberFormatting = True 
     .AppendOnImport = True 
    End With 

    ' ITERATE THROUGH ALL XMLS IN FOLDER 
    fil = Dir(folderToOpen) 
    Do While Len(fil) > 0 
     If Right(fil, 3) = "xml" Then 
      ActiveWorkbook.XmlMaps("evs_rpb_Mapa").Import URL:=folderToOpen & fil 
     End If 
     fil = Dir 
    Loop 

    Application.DisplayAlerts = True 
    Exit Sub 

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical 
    Exit Sub 
End Sub

首先感谢您的回复。我测试过并没有做任何事情。 –

真的吗？你运行宏吗？没有文件对话框启动选择文件夹？卓越！在工作手册中有一个预先存在的XML映射，对我的工作非常有帮助。 – Parfait

是的，我全部复制，当我运行宏时，我在这一行中有错误：On Error GoTo ErrHandle。如果我删除这一行，我有一个菜单来选择xmls，但我无法看到它们。 –

在Excel中打开一个Xml表格

相关推荐