将工作簿* .xml保存到子文件夹时出现Dir问题

时间:2013-07-02 14:43:19

标签: excel excel-vba dir vba

我有一个小脚本,允许我遍历当前文件夹中的所有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

知道我的语法出错了吗?此外,是否可以在静音模式下执行相同的操作?那么没有打开工作簿?

谢谢!

1 个答案:

答案 0 :(得分:1)

您的问题是,您在初始Dir循环中使用了第二个Dir来测试和创建 xml 子目录。

你可以 - 而且应该把它移到循环之外 - 特别是因为它是一次性测试而且不应该循环开始。以下是这样的事情

(根据我在Loop through files in a folder using VBA?中的简单通配符代码示例,您使用了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
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