Dir issue when saving a workbook as *.xml to a subfolder

Question

I have a small script allowing me to traverse through all xslx files in the current folder, and saving them all as xml worksheets.

That works fine, but I'd like to save them in a subfolder, and that's where things go wrong as I'm always saving the same file again. I'm not too familiar with the Dir syntax, so if someone could help me out a bit I would be really grateful.

This part works as expected :

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

and this one fails on me :

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

Any idea where my syntax goes wrong ? Also, is it possible to do the same thing in silent mode ? So without opening the workbooks ?

Thanks !

score 1 · Accepted Answer · edited May 23 '17 at 11:52

Your issue is that you are using a second Dir within your initial Dir loop to test and create the xml subdirectory.

You can - and should move this outside the loop - especially as it is a one-off test and shouldn't be looped to begin with. Something like this below

(You otherwise used Dir fine, as per my simple wildcard code example in 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

Dir issue when saving a workbook as *.xml to a subfolder

1 Answers1