Question

我正在编写一个宏，它将导入一些XML数据，然后用它做一些聪明的事情。以下代码打开XML但作为新工作簿 - 任何人都可以建议如何将其打开到当前工作簿中？

Dim fNameAndPath As Variant

fNameAndPath = Application.GetOpenFilename(FileFilter:="XML Files (*.xml), *.xml", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fNameAndPath

干杯

编辑 - 这是一些完成工作的代码

Sub OpenXML()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim newSheet As Worksheet

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="XML Files (*.xml), *.xml", _
MultiSelect:=True, Title:="XML File to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If

For x = 1 To UBound(FilesToOpen)

    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
     'wkbTemp.Sheets(1).Copy
    wkbTemp.Sheets(1).Cells.Copy
     ' here you just want to create a new sheet and paste it to that sheet
    Set newSheet = ThisWorkbook.Sheets.Add
    With newSheet
        .Name = "Original_XML"
        .PasteSpecial
    End With
    Application.CutCopyMode = False
    wkbTemp.Close
Next x
End Sub()

Answer 1

您可以通过这种方式将xml导入工作簿而无需打开它：

ThisWorkbook.XmlImport URL:= _
    s_FilePath, ImportMap:=Nothing, _
    Overwrite:=True, Destination:=Sheets("Sheet1").Range("A1")

在您的代码中，它看起来像这样：

Sub OpenXML()
Dim FilesToOpen
Dim x As Integer

Dim sDelimiter As String
Dim newSheet As Worksheet

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="XML Files (*.xml), *.xml", _
MultiSelect:=True, Title:="XML File to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If

With ActiveWorkbook
    For x = 1 To UBound(FilesToOpen)
        Set newSheet = .Sheets.Add
        newSheet.Name = "Original_XML_" & x
        Application.DisplayAlerts = False
        .XmlImport URL:= _
            FilesToOpen(x), ImportMap:=Nothing, _
            Overwrite:=True, Destination:=newSheet.Range("A1")
        Application.DisplayAlerts = True
    Next x
End With

ExitHandler:
ErrHandler:
End Sub

在与宏相同的工作簿中打开XML文件

1 个答案: