Loop through subfolders

[AMAS]

Hi,

I've been racking my brains on this but can't seem to get it working. I have this code below that works file looping through all the files in one folder. What I'm trying to do is make loop through all subfolders also.

Any help is highly appreciated.

Sub Convert_CSV()
Dim screenUpdateState       As Variant
Dim statusBarState          As Variant
Dim eventsState             As Variant
Dim fso                     As Object
Dim fPath                   As String
Dim myFolder, myFile
Dim wb                      As Workbook
Dim SavePath                As String
 
' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
 
' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        .InitialFileName = "C:\Users\HP-Server\Desktop\"               ' Default path
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
            If .SelectedItems.Count = 0 Then
                MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
                Exit Sub
            End If
    End With
' Open each file consequently
        Set myFolder = fso.GetFolder(fPath).Files
            For Each myFile In myFolder
                If LCase(myFile) Like "*.csv" Then
' Perform tasks with each file
 
     ' More code here
 
' Save file in original folder, but as csv file format
     SavePath = fso.GetFolder(fPath).Name & "\" & fso.GetBaseName(myFile) & ".csv"
     wb.SaveAs fileName:=SavePath, FileFormat:=xlCSV, CreateBackup:=False
' Close file
     wb.Close True
End If
 
' Loop through all files in folder
            Next myFile
'clean up
    myFile = vbNullString
    I = 1
' Turn Excel functionality back on
    Application.ScreenUpdating = screenUpdateState
    Application.DisplayStatusBar = statusBarState
    Application.EnableEvents = eventsState
End Sub

AMAS

 

[Domenic]

This part of the code...

If LCase(myFile) Like "*.csv" Then

...selects CSV files. Yet you say that you'd like to convert each file to a CSV file. Do you actually want to open Excel files, do stuff, and then save it as a CSV file in its original folder?

 

[AMAS]

Hi Dominic,

This is part of a code I use for looping through .csv files only, but of course can be modified to look at excel files (*.xls*). I have learned how to manage this aspect and how to loop through files in the same folder. I just can't figure out how to loope through subfolders. I have seen examples that use a function, but I have not been able to incorporate that code into mine.

Any suggestions?

AMAS

 

[Domenic]

Try something like this... Place the code in a regular module, and then run 'Convert_CSV'...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] Convert_CSV()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] FileSystemObject
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] CalcMode [color=darkblue]As[/color] [color=darkblue]Long[/color]

    [color=darkblue]With[/color] Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        .InitialFileName = "C:\Users\HP-Server\Desktop\"
        .AllowMultiSelect = [color=darkblue]False[/color]
        .Show
        [color=darkblue]If[/color] .SelectedItems.Count > 0 [color=darkblue]Then[/color]
            strPath = .SelectedItems(1) & "\"
        [color=darkblue]Else[/color]
            MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
            [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = [color=darkblue]False[/color]
        .EnableEvents = [color=darkblue]False[/color]
        .DisplayAlerts = [color=darkblue]False[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
    
    [color=darkblue]Call[/color] ProcessFolders(objFSO, strPath)
    
    [color=darkblue]With[/color] Application
        .Calculation = CalcMode
        .ScreenUpdating = [color=darkblue]True[/color]
        .EnableEvents = [color=darkblue]True[/color]
        .DisplayAlerts = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Sub ProcessFolders([color=darkblue]ByRef[/color] fso, [color=darkblue]ByVal[/color] fpath)

    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objSubFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] File
    [color=darkblue]Dim[/color] wkb [color=darkblue]As[/color] Workbook
    
    [color=darkblue]Set[/color] objFolder = fso.GetFolder(fpath)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objFolder.Files
        [color=darkblue]If[/color] LCase(objFile.Name) [color=darkblue]Like[/color] "*.xls*" [color=darkblue]Then[/color]
            [color=darkblue]Set[/color] wkb = Workbooks.Open(objFile)
                [color=green]'Your code[/color]
            wkb.SaveAs Left(objFile, InStr(1, objFile, ".xls") - 1), xlCSV
            wkb.Close savechanges:=[color=darkblue]False[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] objFile
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objSubFolder [color=darkblue]In[/color] objFolder.SubFolders
        [color=darkblue]Call[/color] ProcessFolders(fso, obj[color=darkblue]Sub[/color]Folder)
    [color=darkblue]Next[/color] objSubFolder

[color=darkblue]End[/color] Sub
[/font]

 

[AMAS]

Thanks Dominic. This is really helpful.

If you don't mind, I do have a few questions so I can understand what the best options for standardize these macro are.

Q1) Is there a way to determine if subfolders are present and then let the user indicate whether or not to loop through the subfolders or just use the original folder (without any subfolders)?

Q2) Would be possible to allow the user to choose the file type (e.g. extension) that should be used instead of being hard-coded?

AMAS