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

在与宏相同的工作簿中打开XML文件,xml,excel,vba,Xml,Excel,Vba,我正在写一个宏,它将导入一些XML数据,然后用它做一些聪明的事情。下面的代码将XML作为新工作簿打开-有人能建议如何将其打开到当前工作簿中吗 Dim fNameAndPath As Variant fNameAndPath = Application.GetOpenFilename(FileFilter:="XML Files (*.xml), *.xml", Title:="Select File To Be Opened") If fNameAndPath = False Then Exi

我正在写一个宏,它将导入一些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()

您可以通过这种方式将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