Run Macro on All Files in a Folder

[ctmccorm]

Hi all,

New to VBA and trying to figure out how to write a loop to run a macro on all files in a certain folder. I have found codes similar to the one below but am having trouble modifying it to fit my needs. The folder I'm trying to run it on is "C:\Users\\Documents\MS Analysis" and I'm trying to run a macro labeled MS_Survey_2

Any help would be greatly appreciated.

Sub nicework2()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = ActiveWorkbook.Path ' current path
Dim strExtension As String
'Comment out the 3 lines below to debug
'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"
.Close SaveChanges:=True
End With

strExtension = Dir
Wend

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

 

[Hui]

Firstly, Welcome to the Chandoo.org Forums

Try the following there are 2 changes, MyDir= and Call lines

Sub nicework2()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "C:\Users\\Documents\MS Analysis" 'This is the path to your files

'Comment out the 3 lines below to debug'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 MS_Survey_2 'I assume you want to run this macro on every open file
.Close SaveChanges:=True
End With

strExtension = Dir
Wend

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

 

[ctmccorm]

That worked perfectly, thanks so much!

 

[shashikantv]

Hi,

I am using above code to run macro named "noc" in all the files in one folder. but it is not working.

Sub nicework2()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "F:\Behariji Mills Pvt Ltd\remaining" 'This is the path to your files

'Comment out the 3 lines below to debug'Application.ScreenUpdating = False'Application.Calculation = xlCalculationManual'On Error Resume Next
strExtension = Dir(MyDir & "\*.xlsb")


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

With wbOpen

Call noc

.Close SaveChanges:=True
End With

strExtension = Dir
Wend

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

MOD EDIT: CODE TAGS ADDED.