Pulling data from multiple files in multiple folders

[rage557]

Hi all,

I just joined the forum and have a quick question I hope you guys can answer. I've been searching for a solution but have not found the correct code to use.

I have a single folder, within that folder are many other folders, within each of those folders are many csv files. I need to pull a few cells worth of data out of each of those files.

At this point I know I need to set the top folder as my folder path. Then place a loop in the code so that it will open the first file in each folder and then move on to the next folder. The 1st level folder is named DATA, 2nd level folder names are MON900 to MON 1146.


Thoughts?

 

[Trevor G]

Welcome to the forum,

Which MS Office version are you using as 2003 has a file search facility and in 2007 it has been taken away.

If using 2003 you can use something like this. The excel workbook names are printed to the Debug window hence the line in Blue, so it would be here to do what you need. Change the folder name and path in red.

Sub fileSearch1()
Dim varItem As Variant
With Application.FileSearch
.Filename = "*.xls"
.LookIn = "[COLOR=red]C:\Folder name[/COLOR]"
.SearchSubFolders = True
.Execute
For Each varItem In .FoundFiles
[COLOR=blue]Debug.Print varItem
[/COLOR]Next varItem
End with
End Sub

 

[brettdj]

You can use a recursive approach like my sample below in xl2007 and xl2010 to walk all the paths in place of the useful FileSearch method mentioned by Trevor above

This sample produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folder, orginally written up at http://www.experts-exchange.com/A_2839.html

From your initial question it appears you may have some expertise in tailoring code ("looking for solution"), if not then pls let us know and the code below can be tweaked to open each workbook and pull the data, rather than the mp3 properties

cheers
Dave

Option Explicit

Public StrArray()
Public lngCnt As Long
Public b_OS_XP As Boolean

Public Enum MP3Tags
    '  See http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1 for OS specific attribute lists
    XP_Artist = 16
    XP_AlbumTitle = 17
    XP_SongTitle = 10
    XP_TrackNumber = 19
    XP_RecordingYear = 18
    XP_Genre = 20
    XP_Duration = 21
    XP_BitRate = 22
    Vista_W7_Artist = 13
    Vista_W7_AlbumTitle = 14
    Vista_W7_SongTitle = 21
    Vista_W7_TrackNumber = 26
    Vista_W7_RecordingYear = 15
    Vista_W7_Genre = 16
    Vista_W7_Duration = 17
    Vista_W7_BitRate = 28
End Enum

Public Sub Main()
    Dim objws
    Dim objEnv
    Dim objFSO
    Dim objFolder
    Dim strMyDoc As String
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim strOs As String

    'Setup Application for the user
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'reset public variables
    lngCnt = 0
    ReDim StrArray(1 To 1000, 1 To 10)

    ' Use wscript to automatically locate the My Documents directory
    Set objws = CreateObject("wscript.shell")
    Set objEnv = objws.Environment("System")

    strOs = objEnv("OS")
    strMyDoc = objws.specialfolders("MyDocuments")
  

    If InStr(strOs, "XP") Or InStr(strOs, "NT") Then
        b_OS_XP = True
    Else
        b_OS_XP = False
    End If

    ' Format output sheet
    Set Wb = Workbooks.Add(1)
    Set ws = Wb.Worksheets(1)
    ws.[a1] = Now()
    ws.[a2] = strOs
    ws.[a3] = strMyDoc
    ws.[a1:a3].HorizontalAlignment = xlLeft

    ws.[A4:J4].Value = Array("Folder", "File", "Artist", "Album Title", "Song Title", "Track Number", "Recording Year", "Genre", "Duration", "Bit Rate")
    ws.Range([a1], [j4]).Font.Bold = True
    ws.Rows(5).Select
    ActiveWindow.FreezePanes = True


    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strMyDoc & "\My Music\")
    
    ' Start the code to gather the files
    ShowSubFolders objFolder, True
    ShowSubFolders objFolder, False

    If lngCnt > 0 Then
        ' Finalise output
        With ws.Range(ws.[a5], ws.Cells(5 + lngCnt - 1, 10))
            .Value2 = StrArray
            .Offset(-1, 0).Resize(Rows.Count - 3, 10).AutoFilter
            .Offset(-4, 0).Resize(Rows.Count, 10).Columns.AutoFit
        End With
        ws.[a1].Activate
    Else
        MsgBox "No files found!", vbCritical
        Wb.Close False
    End If

    ' tidy up
    
    Set objFSO = Nothing
    Set objws = Nothing
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .StatusBar = vbNullString
    End With
End Sub



Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)
    Dim objShell
    Dim objShellFolder
    Dim objShellFolderItem
    Dim colFolders
    Dim objSubfolder


    'strName must be a variant, as ParseName does not work with a string argument
    Dim strFname
    Set objShell = CreateObject("Shell.Application")
    Set colFolders = objFolder.SubFolders
    Application.StatusBar = "Processing " & objFolder.Path

    If bRootFolder Then
        If objFolder.Name = "My Music" Then
            Set objSubfolder = objFolder
            GoTo OneTimeRoot
        End If
    End If

    For Each objSubfolder In colFolders
        'check to see if root directory files are to be processed
OneTimeRoot:
        strFname = Dir(objSubfolder.Path & "\*.mp3")
        Set objShellFolder = objShell.Namespace(objSubfolder.Path)
        Do While Len(strFname) > 0
            lngCnt = lngCnt + 1
            If lngCnt Mod 1000 = 0 Then ReDim Preserve StrArray(lngCnt + 1000, 10)
            Set objShellFolderItem = objShellFolder.ParseName(strFname)
            StrArray(lngCnt, 1) = objSubfolder
            StrArray(lngCnt, 2) = strFname
            If b_OS_XP Then
                StrArray(lngCnt, 3) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Artist)
                StrArray(lngCnt, 4) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_AlbumTitle)
                StrArray(lngCnt, 5) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_SongTitle)
                StrArray(lngCnt, 6) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_TrackNumber)
                StrArray(lngCnt, 7) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_RecordingYear)
                StrArray(lngCnt, 8) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Genre)
                StrArray(lngCnt, 9) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Duration)
                StrArray(lngCnt, 10) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_BitRate)
            Else
                StrArray(lngCnt, 3) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Artist)
                StrArray(lngCnt, 4) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_AlbumTitle)
                StrArray(lngCnt, 5) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_SongTitle)
                StrArray(lngCnt, 6) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_TrackNumber)
                StrArray(lngCnt, 7) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_RecordingYear)
                StrArray(lngCnt, 8) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Genre)
                StrArray(lngCnt, 9) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Duration)
                StrArray(lngCnt, 10) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_BitRate)
            End If
            strFname = Dir
        Loop
        If bRootFolder Then Exit Sub
        ShowSubFolders objSubfolder, False
    Next
End Sub

 

[rage557]

Thanks guys. I'm not an expert in VBA by any stretch of the imagination. I've just started learning but it seems pretty intuitive so I've been able to pick up quite a bit. I'll try the codes and let you know how I make out.

 

[rage557]

Thanks guys. I'm not an expert in VBA by any stretch of the imagination. I've just started learning but it seems pretty intuitive so I've been able to pick up quite a bit. I'll try the codes and let you know how I make out.

I should also specify I am using XL 2010