Macro that loops through all monthly folders
Attend Excelapalooza
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: Macro that loops through all monthly folders

  1. #1
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Exclamation Macro that loops through all monthly folders

     
    Dear all,

    I am in need of your advice/expertise as I'm currently stuck on programming a macro in Access due to lack of knowledge.
    Hereunder I'm giving you some background information which gives you an idea of the requirements for the macro:

    Background information
    - There are 12 monthly folders as we are working on a fiscal year basis
    - Each monthly folder contains another 9 RBU (Regional Business Unit) folders
    - Each RBU is split up in multiple country folders -> e.g. CENTER would be Austria/Germany/Switzerland, IBERIA would be Spain, Portugal
    - The file names - in the country folders - are always named with the following structure: [VIVA][PRODUCT][COUNTRY][VF] -> e.g. VIVA_LEAF_EGB_VF
    - The path file to these files will be something like this -> I:\R&E Internal\01 Reporting & Tools\06 Transaction Price\Transaction price report G5\14 - MOSY FY17\06_September\CEN\GER\Published

    What do I want?
    The idea is to set up 9 RBU Access databases that contains a macro which automatically loops through each of these monthly folders to consolidate all the data. Each time I run the macro it should restart the entire looping process where it deletes the existing information in Access and re-consolidates the data. I'm completely aware of it not being the most efficient way, but the aim is to provide accurate data as historical information could change due to whatever reason.

    Is this even feasible?
    If you need additional information, please let me know so I can provide you this

    Many thanks for your time & willingness to help me out

    Have a nice day

    PS: I wanted to upload a local picture, but I don't see the URL

    Djani

  2. #2
    Board Regular ranman256's Avatar
    Join Date
    Jun 2014
    Location
    Kentucky
    Posts
    1,557
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    The idea should be, load in all data (excel?)
    v1. then STOP using excel data and input data in access.
    or
    v2. Stop importing ALL historical data (once loaded) then continue to load ONLY new sheets that come in.

    not
    load all historical data over and over, etc.

  3. #3
    Board Regular ranman256's Avatar
    Join Date
    Jun 2014
    Location
    Kentucky
    Posts
    1,557
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    the code below will cycle thru all folders and import excel sheets, assuming they are all designed alike and all import to the same table.
    modify as needed:

    usage:
    ImportAllFoldersAndSubFolders "c:\folder\folder2"

    Code:
    Public Sub ImportAllFoldersAndSubFolders(ByVal pvDir)
        Dim fso, oFolder, oSubfolder, oFile, queue As Collection
        Dim vFile
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set queue = New Collection
        queue.Add fso.GetFolder(pvDir) 'obviously replace
    
    
        Do While queue.Count > 0
            Set oFolder = queue(1)
            queue.Remove 1
            
                For Each oFile In oFolder.Files
                                  '...insert any file processing code here...
                    If InStr(oFile.Name, ".xls") > 0 Then
                       Debug.Print oFile.Name, oFolder
                       vFile = oFolder & "\" & oFile.Name
                       DoCmd.TransferSpreadsheet acImport, "tTable1", vFile, True
                    End If
                Next oFile
            
            For Each oSubfolder In oFolder.SubFolders
                queue.Add oSubfolder
                Debug.Print oSubfolder
            Next oSubfolder
        Loop
        
    Set fso = Nothing
    Set oFolder = Nothing
    Set oSubfolder = Nothing
    Set oFile = Nothing
    Set queue = Nothing
    End Sub
    Last edited by ranman256; Nov 15th, 2017 at 08:14 AM.

  4. #4
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    @ranman256, many thanks for your input

    I was digging a little deeper and in the end I was able to assemble a macro which automatically loops through one folder and copy-pastes the data into the open workbook:

    Code:
    Sub LoopThroughFolder()
        Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
        Dim Rws As Long, Rng As Range
        Set Wb = ThisWorkbook
        'change the address to suite
        MyDir = "H:\My Documents\Djani\MPCR\Project\FY17\CEN\GER\Qashqai\"
        MyFile = Dir(MyDir & "*.xlsb")    'change file extension
        ChDir MyDir
        Application.ScreenUpdating = 0
        Application.DisplayAlerts = 0
        Do While MyFile <> ""
            Workbooks.Open (MyFile)
            With Worksheets("Monthly_DB")
                Rws = .Cells(Rows.Count, "A").End(xlUp).Row
                Set Rng = Range(.Cells(2, 64), .Cells(Rws, 2))
                Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                ActiveWorkbook.Close False
            End With
            MyFile = Dir()
        Loop
    End Sub
    However, as this macro is purely designed to loop through one folder, what should I modify within this macro in order for it to loop through multiple subfolders?
    I want it to do the exact same thing by copy-pasting the data in the files that are located within the subfolders.

    Hopefully you can help me with this!

  5. #5
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    Hey guys,

    Sorry to bump the thread, but can anybody help me out on this?

    In the meantime I dug a little deeper and found a macro that finds and lists all files in a directory and its subdirectories (http://software-solutions-online.com...ubdirectories/)

    Code:
    Option Explicit
    'the first row with data
    Const ROW_FIRST As Integer = 5
    'This is an event handler. It executes when the user presses the run button
    Private Sub btnGet_Click()
    'determines if the user selects a directory from the folder dialog
    Dim intResult As Integer
    'the path selected by the user from the folder dialog
    Dim strPath As String
    'Filesystem object
    Dim objFSO As Object
    'the current number of rows
    Dim intCountRows As Integer
    Application.FileDialog(msoFileDialogFolderPicker).Title = _
    "Select a Path"
    'the dialog is displayed to the user
    intResult = Application.FileDialog( _
    msoFileDialogFolderPicker).Show
    'checks if user has cancled the dialog
    If intResult <> 0 Then
     strPath = Application.FileDialog(msoFileDialogFolderPicker _
     ).SelectedItems(1)
    'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
    'loops through each file in the directory and prints their names and path
     intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
    'loops through all the files and folder in the input path
     Call GetAllFolders(strPath, objFSO, intCountRows)
    End If
    End Sub
    '''
    'This function prints the name and path of all the files in the directory strPath
    'strPath: The path to get the list of files from
    'intRow: The current row to start printing the file names
    'objFSO: A Scripting.FileSystem object.
    Private Function GetAllFiles(ByVal strPath As String, _
    ByVal intRow As Integer, ByRef objFSO As Object) As Integer
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    i = intRow - ROW_FIRST + 1
    Set objFolder = objFSO.GetFolder(strPath)
    For Each objFile In objFolder.Files
     'print file name
     Cells(i + ROW_FIRST - 1, 1) = objFile.Name
    'print file path
     Cells(i + ROW_FIRST - 1, 2) = objFile.Path
     i = i + 1
    Next objFile
    GetAllFiles = i + ROW_FIRST - 1
    End Function
    '''
    'This function loops through all the folders in the
    'input path. It makes a call to the GetAllFiles
    'function. It also makes a recursive call to itself
    'strFolder: The folder to loop through
    'objFSO: A Scripting.FileSystem object
    'intRow: The current row to print the file data on
    Private Sub GetAllFolders(ByVal strFolder As String, _
    ByRef objFSO As Object, ByRef intRow As Integer)
    Dim objFolder As Object
    Dim objSubFolder As Object
    'Get the folder object
    Set objFolder = objFSO.GetFolder(strFolder)
    'loops through each file in the directory and
    'prints their names and path
    For Each objSubFolder In objFolder.subfolders
     intRow = GetAllFiles(objSubFolder.Path, _
     intRow, objFSO)
    'recursive call to to itsself
     Call GetAllFolders(objSubFolder.Path, _
     objFSO, intRow)
    Next objSubFolder
    End Sub
    Is there any possibility to combine this macro with the one I posted earlier?
    The goal is to copy-paste the data from sheet "Monthly_DB" of all files in the folders

    Please let me know if you need some additional information!

  6. #6
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    Hello all,

    Sorry for bumping this thread, but is there anyone that could possibly help me out?
    I still haven't found a solution in finding a macro that automatically loops through all excel files within a directory

    Kind regards

    Djani

  7. #7
    Board Regular
    Join Date
    Jul 2010
    Posts
    209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    You mention access (and this is an access forum) however your example on post #4 is an excel macro.

    If Excel is fine for this then there is a nice little add on for excel here : https://www.rondebruin.nl/win/addins/rdbmerge.htm

    There is also various code examples on the same site that can be fairly easily adapted to suit access.

  8. #8
    Board Regular
    Join Date
    Sep 2017
    Posts
    118
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Macro that loops through all monthly folders

    HI,

    Have you considered using Power BI? It seems this would probably be make your task a lot more simple.

    Dan.

  9. #9
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

    Hello stumac,

    My bad.. thanks a lot for the help anyways
    I was able to find a macro - created by Ron de Bruin - but I want to customize it a little to my own needs.

    Code:
    Sub MergeAllWorkbooks()
        Dim MyPath As String, FilesInPath As String
        Dim MyFiles() As String
        Dim SourceRcount As Long, FNum As Long
        Dim mybook As Workbook, BaseWks As Worksheet
        Dim sourceRange As Range, destrange As Range
        Dim rnum As Long, CalcMode As Long
        Dim FirstCell As String
    
    
        ' Change this to the path\folder location of your files.
        MyPath = "H:\My Documents\Djani\MPCR\Project\FY17\CEN\GER\Qashqai"
    
    
        ' Add a slash at the end of the path if needed.
        If Right(MyPath, 1) <> "\" Then
            MyPath = MyPath & "\"
        End If
    
    
        ' If there are no Excel files in the folder, exit.
        FilesInPath = Dir(MyPath & "*.xl*")
        If FilesInPath = "" Then
            MsgBox "No files found"
            Exit Sub
        End If
    
    
        ' Fill the myFiles array with the list of Excel files
        ' in the search folder.
        FNum = 0
        Do While FilesInPath <> ""
            FNum = FNum + 1
            ReDim Preserve MyFiles(1 To FNum)
            MyFiles(FNum) = FilesInPath
            FilesInPath = Dir()
        Loop
    
    
        ' Set various application properties.
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
    
        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
    
    
        ' Loop through all files in the myFiles array.
        If FNum > 0 Then
            For FNum = LBound(MyFiles) To UBound(MyFiles)
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
                On Error GoTo 0
    
    
                If Not mybook Is Nothing Then
                    On Error Resume Next
    
    
                    ' Change this range to fit your own needs.
                    With mybook.Worksheets("7 - Monthly_DB")
                       FirstCell = "A2"
                       Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
                       ' Test if the row of the last cell is equal to or greater than the row of the first cell.
                       If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
                          Set sourceRange = Nothing
                       End If
                    End With
    
    
                    If Err.Number > 0 Then
                        Err.Clear
                        Set sourceRange = Nothing
                    Else
                        ' If source range uses all columns then
                        ' skip this file.
                        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                            Set sourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0
    
    
                    If Not sourceRange Is Nothing Then
    
    
                        SourceRcount = sourceRange.Rows.Count
    
    
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "There are not enough rows in the target worksheet."
                            BaseWks.Columns.AutoFit
                            mybook.Close savechanges:=False
                            GoTo ExitTheSub
                        Else
    
    
                            ' Set the destination range.
                            Set destrange = BaseWks.Range("A" & rnum)
    
    
                            ' Copy the values from the source range
                            ' to the destination range.
                            With sourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = sourceRange.Value
    
    
                            rnum = rnum + SourceRcount
                        End If
                    End If
                    mybook.Close savechanges:=False
                End If
    
    
            Next FNum
            BaseWks.Columns.AutoFit
        End If
    
    
    ExitTheSub:
        ' Restore the application properties.
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    End Sub
    When I run this macro it automatically opens a new workbook and merges all data in there, but I'd like to have the data merged in the current/open workbook.

    I understand I have to change the "BaseWks" variable etc. but I'm not entirely sure how to adapt the rest of the macro.
    Is this something you can help me with?

    Many thanks

    Djani
    Last edited by Djani; Feb 20th, 2018 at 05:26 AM. Reason: add info

  10. #10
    Board Regular
    Join Date
    Aug 2015
    Posts
    61
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro that loops through all monthly folders

      
    Quote Originally Posted by Youngdand View Post
    HI,

    Have you considered using Power BI? It seems this would probably be make your task a lot more simple.

    Dan.
    For sure, but I'm not yet at that stage. Streamlining all data is currently the main task I'm focused on, and this is going to take some time as I literally had to start from ground-zero. The company I'm working for is somewhat 90% Excel based.

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com