對文件夾中的所有子文件夾執行相同操作

Question

由於下面的代碼將「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 \」中的任何文件，只有子文件夾。

Answer 1

這裏有一個通用的解決方案，你不需要知道子文件夾的名稱。這將找到所有子文件夾並處理其中每個文件夾中的電子表格。

您需要通過單擊工具菜單來引用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 

Answer 2

你可以將它們添加到一個簡單的數組和循環遍歷它：

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