Importing .xml into Excel

Question

我有一个宏代码下面的Excel 2007。我需要导入。xml文件到Excel。有1000个.xml文件。模式只有80%是相同的。我需要将它们导入Excel并将其导出为带分号的。csv。我已经插入代码到Excel宏。但是当我执行它时，文件没有被导入。

有谁能帮我检查代码，代码是否适用于我的场景?

Sub From_XML_To_XL_02
On Error GoTo errh
Dim myWB As Workbook, WB As Workbook
Set myWB = ThisWorkbook
Dim myPath
  myPath = "C:WorkFolderProjects"
Dim myFile
  myFile = Dir(myPath & "*.xml")
Dim t As Long, N As Long, r As Long, c As Long
  t = 1
  N = 0
Application.ScreenUpdating = False
Do While myFile <> ""
   N = N + 1
   Set WB = Workbooks.OpenXML(FileName:=myPath & myFile, LoadOption:=xlXmlLoadImportToList)
   If N > 1 Then
        r = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        WB.Sheets(1).Range(Cells(3, "A"), Cells(r, c)).Copy myWB.Sheets(1).Cells(t, "A")
   Else
      WB.Sheets(1).UsedRange.Copy myWB.Sheets(1).Cells(t, "A")
  End If
WB.Close False
t = myWB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
myFile = Dir()
  Loop
Application.ScreenUpdating = True
  myWB.Save
Exit Sub
errh:
 MsgBox "no files xml"
End Sub

Answer 1

我已经在你的代码做了一些改变，现在它的工作和保存文件，如File1.xls, File2.xls等。您的代码上已标记了更改。还有一个小问题:最后一个文件虽然保存了，但在工作区中仍然是打开的。由于我忙于其他事情，我无法进一步研究这个问题。我希望你能解决这个问题。修改代码如下。

 Sub From_XML_To_XL_02
    On Error GoTo errh
    Dim myWB As Workbook, WB As Workbook
    Set myWB = ThisWorkbook
    Dim myPath
    myPath = "C:WorkFolderProjects"
    Dim myFile
    myFile = Dir(myPath & "*.xml")
    Dim t As Long, N As Long, r As Long, c As Long
    t = 1
    N = 0
    Application.ScreenUpdating = False
    Do While Len(myFile) > 0             'Do While myFile <> ""
     N = N + 1
      Set WB = Workbooks.OpenXML(ThisWorkbook.Path & "" & myFile)   ' Set WB = Workbooks.OpenXML(FileName:=myPath & myFile, LoadOption:=xlXmlLoadImportToList)
       If N > 1 Then
        r = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = WB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        WB.Sheets(1).Range(Cells(3, "A"), Cells(r, c)).Copy myWB.Sheets(1).Cells(t, "A")
        Else
        WB.Sheets(1).UsedRange.Copy myWB.Sheets(1).Cells(t, "A")
      End If
                                     'WB.Close False
      t = myWB.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    myWB.SaveAs Filename:="C:WorkFolderProjectsFiles" & N & ".xls" 'added save path here to save in different files
    WB.Close False
    myFile = Dir()
    Loop
    Application.ScreenUpdating = True
    myWB.Save
Exit Sub
 errh:
 MsgBox "no files xml"
 End Sub