对文件夹

时间:2015-06-16 04:37:07

标签: excel excel-vba vba

鉴于以下代码转换了" C:\ Files \ Bangalore"内的所有xlsx文件到csv文件。

Sub xlsxTOcsv()
Dim sPathInp    As String
Dim sPathOut    As String
Dim sFile       As String
sPathInp = "C:\Files\Bangalore\"
sPathOut = "C:\Files\Bangalore"
Application.DisplayAlerts = False
sFile = Dir(sPathInp & "*.xlsx")
Do While Len(sFile)
    With Workbooks.Open(fileName:=sPathInp & sFile)
        .SaveAs fileName:=sPathOut & Left(.Name, InStr(1, .Name, ".") - 1), _
                fileformat:=xlCSV, _
                CreateBackup:=False
        .Close SaveChanges:=False
    End With
    sFile = Dir()
Loop
Kill sPathInp & "\" & "*.xlsx"
End Sub

问题是我的" C:\ Files \"中有很多类似的文件夹。对于不同的城市。

代表:

  

C:\文件\奈
    C:\文件\德里
    C:\文件\加尔各答
    C:\文件\孟买

我在所有这些文件夹中执行相同的操作。

有没有办法通过调用" C:\ Files \"对所有这些子文件夹执行相同的操作? ?

我没有" C:\ Files \"中的任何文件,只有子文件夹。

2 个答案:

答案 0 :(得分:2)

这是一个通用解决方案,您无需知道子文件夹的名称。这将找到所有子文件夹并处理每个子文件夹中的电子表格。

您需要引用Windows Script Host Object Model,您可以点击工具菜单,引用...,然后向下滚动并勾选Windows Script Host Object Model

Sub xlsxTOcsv()

Dim sPathInp    As String
Dim sPathOut    As String
Dim sFile       As String
Dim rootFolderPath As String
Dim rootFolder As Folder
Dim subFolder As Folder

rootFolderPath = "C:\Files"

''You need to add a reference to Windows Script Host Object Model

Dim fso As New FileSystemObject

Application.DisplayAlerts = False

Set rootFolder = fso.GetFolder(rootFolderPath)

For Each subFolder In rootFolder.SubFolders

    sPathInp = subFolder.Path & "\"
    sPathOut = sPathInp

    sFile = Dir(sPathInp & "*.xlsx")
    Do While Len(sFile)
        With Workbooks.Open(Filename:=sPathInp & sFile)
            .SaveAs Filename:=sPathOut & Left(.Name, InStr(1, .Name, ".") - 1), _
                    FileFormat:=xlCSV, _
                    CreateBackup:=False
            .Close SaveChanges:=False
        End With
        sFile = Dir()
    Loop
    Kill sPathInp & "*.xlsx"

Next subFolder


Application.DisplayAlerts = True

End Sub

答案 1 :(得分:0)

您可以将它们添加到一个简单的数组中并循环遍历它:

Sub xlsxTOcsv()
Dim sPathInp    As String
Dim sPathOut    As String
Dim sFile       As String
Dim vArr
Dim vFile

vArr = Array("Bangalore", "Chennai", "Delhi", "Kolkata")

sPathInp = "C:\Files\"
sPathOut = "C:\Files\"

Application.DisplayAlerts = False
For Each vFile In vArr
sFile = Dir(sPathInp & vFile & "\*.xlsx")
Do While Len(sFile)
    With Workbooks.Open(Filename:=sPathInp & vFile & "\" & sFile)
        .SaveAs Filename:=sPathOut & vFile & "\" & Left$(.Name, InStr(1, .Name, ".") - 1), _
                FileFormat:=xlCSV, _
                CreateBackup:=False
        .Close SaveChanges:=False
    End With
    sFile = Dir()
Loop
Kill sPathInp & vFile & "\" & "*.xlsx"
Next
Application.DisplayAlerts = True

End Sub