Question

我查了几个教程和类似的问题，但我无法解决我的问题。

我可以做我需要的，但是这个选项打开一个新的工作簿，然后将所有内容复制到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

Answer 1

考虑从文件夹选择器对话框中选择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

在Excel中打开Xml表

1 个答案: