Run macro on all files in a folder

[jimmisavage]

Good day,
I have a folder which has a bunch of spreadsheets in them - we're constantly adding and deleting but they're all from the same template. I don't want to put macro's in these files because it seems to scare people in my work!!

I have found a bit of code, which opens the first file but then gives me a subscript out of range warning before running my codes.

Sub RunOnAllFilesInFolder()
    
    folderName = "S:\Haemophilia\Reports\Study Updates\"
    If Right(folderName, 1) <> Application.PathSeparator Then folderName = folderName & Application.PathSeparator
    Fname = Dir(folderName & "*.xlsx")

    'loop through the files
    Do While Len(Fname)

        With Workbooks.Open(folderName & Fname)

           ' here comes the code for the operations on every file the code finds
        
        Call Behindthescenes
        Call MainRun
    
        End With

        ' go to the next file in the folder
        Fname = Dir

    Loop
    
End Sub

I figured that this might have been because the macro i'm calling isn't from the newly opened workbook - so i tried this, but get the same error:

Sub RunOnAllFilesInFolder()
    
    folderName = "S:\Haemophilia\Reports\Study Updates\"
    If Right(folderName, 1) <> Application.PathSeparator Then folderName = folderName & Application.PathSeparator
    Fname = Dir(folderName & "*.xlsx")

    'loop through the files
    Do While Len(Fname)

        With Workbooks.Open(folderName & Fname)

           ' here comes the code for the operations on every file the code finds
        Application.Run "'Study Updates Runner.xlsm'!Behindthescenes"
        Application.Run "'Study Updates Runner.xlsm'!Behindthescenes"
    
        End With

        ' go to the next file in the folder
        Fname = Dir

    Loop
    
End Sub

So maybe there is something wrong with my code? I dont think so, because it's quite simple and it works using it normally:

Private Sub Behindthescenes()

    Sheets("New").Visible = True
    Sheets("Old").Visible = True
    Sheets("Temp").Visible = True
    Cells.Select
    Selection.Copy
    Sheets("Old").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Temp").Select
    Range("A1").Select
    Sheets("Summary").Select
    Range("A1").Select

End Sub

Can anyone give me an idea of why this is going wrong? Maybe I have to select the newly opened spreadsheet? How would i do that?

Thanks in advance!
Jimmi

 

[jimmisavage]

I've stumbled across another code. This one looks like it's doing it - it opens all files and does 'something' but once it's finished and i open the files, i can see that nothing has happened.

Sub RunOnAllFilesInFolder()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "S:\Reports\Updates\"


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
strExtension = Dir(MyDir & "\*.xlsx")


While strExtension <> vbNullString
Set wbOpen = Workbooks.Open(MyDir & "\" & strExtension)

With wbOpen
.Worksheets(1).Cells(1, 1).Value = "Hello"
        Call Behindthescenes
        Call MainRun
.Close SaveChanges:=True
End With

strExtension = Dir
Wend

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[jimmisavage]

Is anyone here able to help? I think I'm getting closer. Rather than calling the macro i've decided to try using the code.
This seems to freeze excel, but when i restart it, it's opens up the first file in the folder and copies from the wrong sheet - it doesn't paste it anywhere (I think this is because it doesn't unhide New, Old or Temp - the first lines of my code).

Any help would be appreciated.

Private Sub RunOnAllFilesInFolder()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "S:\Reports\Updates\"


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
strExtension = Dir(MyDir & "\*.xlsx")


While strExtension <> vbNullString
Set wbOpen = Workbooks.Open(MyDir & "\" & strExtension)

With wbOpen
      'here comes my code
    Sheets("New").Visible = True
    Sheets("Old").Visible = True
    Sheets("Temp").Visible = True
    Sheets("Temp").Select
    Cells.Select
    Selection.Copy
    Sheets("Old").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Temp").Select
    Range("A1").Select
    Sheets("Summary").Select
    Range("A1").Select
      'end of my code
.Close SaveChanges:=True
End With

strExtension = Dir
Wend

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[jimmisavage]

It's okay - I've worked it out... The problem is I have to use "ActiveWorkbook." all the time