Dir проблема при сохранении книги как * .xml в подпапку

Question

У меня есть небольшой скрипт, позволяющий пройти через все файлы xslx в текущей папке и сохранить их в виде xml рабочих листов.

Это прекрасно работает, но я хотел бы, чтобы сохранить их в папке, и где дела идут не так, как я всегда сохраняя тот же файл снова. Я не очень хорошо знаком с синтаксисом Dir, поэтому, если кто-то может немного помочь мне, я был бы очень благодарен.

Эта часть работает, как ожидалось:

Sub XLS2XML() 
Application.DisplayAlerts = False 

Dim folderPath As String 
Dim Report As String 
Dim ReportName As String 
Dim XMLLocation As String 
Dim XMLReport As String 

Dim WB As Workbook 

'set path to current location 
folderPath = ThisWorkbook.Path 

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" 

'loop through all xlsx files 
Report = Dir(folderPath & "*.xlsx") 
Do While Report <> "" 
    Set WB = Workbooks.Open(folderPath & Report) 

    'get the file name without path 
    ReportName = Split(Report, ".")(0) 
    XMLLocation = folderPath 
    XMLReport = XMLLocation & ReportName & ".xml" 

    'save the file as xml workbook 
    ActiveWorkbook.SaveAs filename:=XMLReport, _ 
    FileFormat:=xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False 

    'close and next 
    WB.Close False 
    Report = Dir 
Loop 

MsgBox "All XML files have been created" 

Application.DisplayAlerts = True 
End Sub 

и это один не будет работать на меня:

Sub XLS2XML() 
Application.DisplayAlerts = False 

Dim folderPath As String 
Dim Report As String 
Dim ReportName As String 
Dim XMLLocation As String 
Dim XMLReport As String 

Dim WB As Workbook 

'set path to current location 
folderPath = ThisWorkbook.Path 

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" 

'loop through all xlsx files 
Report = Dir(folderPath & "*.xlsx") 
Do While Report <> "" 
    Set WB = Workbooks.Open(folderPath & Report) 

    'get the file name without path and save it in xml folder 
    ReportName = Split(Report, ".")(0) 
    XMLLocation = folderPath & "xml" 
    XMLReport = XMLLocation & "\" & ReportName & ".xml" 

    'create xml folder if it doesn't exist yet 
    If Len(Dir(XMLLocation, vbDirectory)) = 0 Then 
     MkDir XMLLocation 
    End If 

    'save the file as xml workbook 
    ActiveWorkbook.SaveAs filename:=XMLReport, _ 
    FileFormat:=xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False 

    'close and next 
    WB.Close False 
    Report = Dir 
Loop 

Любая идея, где мой синтаксис пойдет не так? Кроме того, можно ли сделать то же самое в бесшумном режиме? Итак, не открывая книги?

Спасибо!

Answer 1

Ваш вопрос в том, что вы используете второй Dir в пределах вашего первоначального Dir петли для тестирования и создать подкаталог XML.

Вы можете - и должны перемещать это вне цикла - тем более, что это одноразовое испытание и не должно быть зациклировано для начала. Нечто подобное ниже

(Вы в противном случае используется Dir штраф, согласно моему простой пример группового символа кода в Loop through files in a folder using VBA?)

Sub XLS2XML() 
Application.DisplayAlerts = False 

Dim folderPath As String 
Dim Report As String 
Dim ReportName As String 
Dim XMLlocation As String 
Dim XMLReport As String 

Dim WB As Workbook 

'set path to current location 
folderPath = ThisWorkbook.Path 
XMLlocation = folderPath & "xml" 

If Len(Dir(XMLlocation, vbDirectory)) = 0 Then MkDir XMLlocation 
If Right$(folderPath, 1) <> "\" Then folderPath = folderPath + "\" 

'loop through all xlsx files 
Report = Dir(folderPath & "*.xlsx") 

Do While Len(Report) > 0 
    Set WB = Workbooks.Open(folderPath & Report) 

    'get the file name without path and save it in xml folder 
    ReportName = Split(Report, ".")(0) 
    XMLReport = XMLlocation & "\" & ReportName & ".xml" 

    'save the file as xml workbook 
    WB.SaveAs Filename:=XMLReport, _ 
    FileFormat:=xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False 

    'close and next 
    WB.Close False 
    Report = Dir 
Loop 
End Sub