I need help modifying a macro to look through folders while running an auto updater.

[Troy1]

Hello,

I have a macro that will automatically update all the spreadsheets in a directory. However the macro will not look through folders for spreadsheets. It will only run on the spreadsheets that are sitting in the immediate directory.

So for example my directory to search for spreadsheets.

C:\Update

I have about 50 folders that I pull off of the shared drive to update the spreadsheets that are in these folders. I put them into the C:\Update directory.

So now I have something like:

C:\Update\CIN Region

The problem is I have to open every single folder on the shared drive and paste the spreadsheets directly into the C:\Update directory. It is tedious work and would like a way to just paste all the folders from the shared drive into the update folder. Then run the macro and have it go through those folders and run the update on spreadsheets.


Here is the macro code:

ub Auto_open_change()


    Dim WrkBook As Workbook
    Dim StrFileName As String
    Dim FileLocnStr As String
    Dim LAARNmeWrkbk As String


    PERNmeWrkbk = ThisWorkbook.Name




    FileLocnStr = "C:\Update\" 'ThisWorkbook.Path


    Dim StrFile As String
    StrFile = Dir(FileLocnStr & "\*.xlsm")
    Do While Len(StrFile) > 0
        DoStuff (FileLocnStr & "\" & StrFile)
        StrFile = Dir
    Loop


End Sub


Private Sub DoStuff(StrFileName)


    Workbooks.Open (StrFileName)
    'Workbooks(StrFileName).Activate


       Call Updateit
       
   




    'Saves and closes workbook


       ActiveWorkbook.RefreshAll
       ActiveWorkbook.Save
       ActiveWorkbook.Close






End Sub

 

[mjbeam]

This code will recursively loop through every file of every subfolder of C:\Update:

Sub Start()

    DoIt "C:\Update"
    
    Application.StatusBar = False
        
End Sub

Public Sub DoIt(ByVal FolderName As String)

    'Setup filesystemobject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Get this folder object
    Set tFolder = fso.GetFolder(FolderName)
    
    'Do stuff to all the files in this folder
    For Each tFile In tFolder.Files
        Application.StatusBar = tFile
        DoStuff tFile
    Next
    
    'Now go into each subfolder in this folder
    For Each sFolder In tFolder.subfolders
        Application.StatusBar = sFolder
        DoIt sFolder 'Recursive function, ie. this function is calling itself from inside itself
    Next

End Sub

 

[Troy1]

Hello thank you for the response. Do I replace the code I listed above with this one? Or do I add it to the code that I listed?

 

[Troy1]

This code will recursively loop through every file of every subfolder of C:\Update:

Sub Start()

    DoIt "C:\Update"
    
    Application.StatusBar = False
        
End Sub

Public Sub DoIt(ByVal FolderName As String)

    'Setup filesystemobject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Get this folder object
    Set tFolder = fso.GetFolder(FolderName)
    
    'Do stuff to all the files in this folder
    For Each tFile In tFolder.Files
        Application.StatusBar = tFile
        DoStuff tFile
    Next
    
    'Now go into each subfolder in this folder
    For Each sFolder In tFolder.subfolders
        Application.StatusBar = sFolder
        DoIt sFolder 'Recursive function, ie. this function is calling itself from inside itself
    Next

End Sub

When I try to run this macro it gives me an error.

"Compile Error: Sub or Function not defined"

Then it takes me to this part of the macro.

 DoStuff tFile

I am not sure what I am doing wrong. I am assuming this part of the code is trying to run my Sub Routine "DoStuff" that was listed in my original macro.

 

[Troy1]

Ok I was able to get it to run but now I am getting a different error. Once its done running on the first folder it stops and this box pops up.

https://drive.google.com/file/d/0B7ZAZgflZvezVGRIWlZaRUg0ZUk/edit?usp=sharing

Then once I click "Cancel" I get another error. It says " Run-time error '1004': Method 'Open' of object 'Workbooks' failed. Then takes me to this line of code.

 Workbooks.Open (StrFileName)

I can not figure this one out. Here is the entire macro.

Sub Start()

    DoIt "C:\Update"
    
    Application.StatusBar = False
        
End Sub


Public Sub DoIt(ByVal FolderName As String)


    'Setup filesystemobject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Get this folder object
    Set tFolder = fso.GetFolder(FolderName)
    
    'Do stuff to all the files in this folder
    For Each tFile In tFolder.Files
        Application.StatusBar = tFile
        DoStuff tFile
    Next
    
    'Now go into each subfolder in this folder
    For Each sFolder In tFolder.subfolders
        Application.StatusBar = sFolder
        DoIt sFolder 'Recursive function, ie. this function is calling itself from inside itself
    Next


End Sub


Private Sub DoStuff(StrFileName)


    Workbooks.Open (StrFileName)
    'Workbooks(StrFileName).Activate


       Call Updateit
       
   
      'Saves and closes workbook


       ActiveWorkbook.RefreshAll
       ActiveWorkbook.Save
       ActiveWorkbook.Close


End Sub

 

[Troy1]

Bump

 

[mjbeam]

It looks like it is trying to open a file that is not an Excel file. Try changing this line:

DoStuff tFile

...to...

If Right(UCase(tFile),4)=".XLS" then DoStuff tFile

...or...

If Right(UCase(tFile),5)=".XLSM" then DoStuff tFile

...or...

If Right(UCase(tFile),5)=".XLSX" then DoStuff tFile

...depending on what extension your Excel files have.

 

[Troy1]

It looks like it is trying to open a file that is not an Excel file. Try changing this line:

DoStuff tFile

...to...

If Right(UCase(tFile),4)=".XLS" then DoStuff tFile

...or...

If Right(UCase(tFile),5)=".XLSM" then DoStuff tFile

...or...

If Right(UCase(tFile),5)=".XLSX" then DoStuff tFile

...depending on what extension your Excel files have.

Thank you very much!!!!! This worked great!