CODEWITHSUNDEEP
excelvba
Abdul Shiyas
Abdul Shiyas

Reputation: 401

Doing a same action to all the subfolders in a folder

Given below code converts all xlsx files inside "C:\Files\Bangalore" to csv files.

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

The problem is I have a lot of similar folders inside my "C:\Files\" for different cities.

for ex:

C:\Files\Chennai
C:\Files\Delhi
C:\Files\Kolkata
C:\Files\Mumbai

etc

I am doing the same action in all these folders.

Is there any way to do the same action to all these subfolders by calling "C:\Files\" ?

I dont have any files in "C:\Files\", only subfolders.

Upvotes: 1

Views: 45

Answers (2)

DeanOC
DeanOC

Reputation: 7282

Here's a generic solution where you don't need to know the names of the subfolders. This will find all the subfolders and process the spreadsheets in each of them.

You need to reference the Windows Script Host Object Model, which you do by clicking the Tools Menu, References..., and then scrolling down and ticking 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

Upvotes: 2

brettdj
brettdj

Reputation: 55702

You could add them to a simple array and loop through it:

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

Upvotes: 0

Related Questions