You can use the following code to execute the macro in all Excel (.xls) files under a given folder. You can tweek a bit if necessary
Sub Exec_Macro_For_All()
Dim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long
On Error GoTo Err_Clk
sPath = "" ' Your Path
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
sDir = Dir$(sPath & "*.xls", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)
Exec_MyMacro() ' Your MAcro here
oWB.Save
oWB.Close False
sDir = Dir$
Loop
Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
Cheers
Shasur
Sorry I barely know any VBA.
ReplyDeleteWhat is Your Path and sPath supposed to mean?
...
" sPath = "" ' Your Path
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\" "
You need to set the variable to the path you want to iterate. For example c:\temp etc
ReplyDeletesPath = "c:\temp" ' Your Path
The next line adds appends "\" to the path variable
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
Hi I find your blog helpful. I am getting an error while executing the code you have provided. This is the first time I am using VBAs and have no experience with them what so ever.
ReplyDeleteThe Macro I want to apply to all files in a folder is called Peak_to_Peak_Value_Calculator. So where you had=> Exec_MyMacro() ' Your MAcro here
I did => Peak_to_Peak_Value_Calculator() ' Your MAcro here
but I am getting a syntax error for Line 1 of the code and the line I changed above. Thanks a lot
Are you getting the error in Peak_to_Peak_Value_Calculator() module or in the main module.
ReplyDeleteThe code opens the set of workbook and executes a macro
Sub Exec_Macro1_For_All()
ReplyDeleteDim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long
On Error GoTo Err_Clk
sPath = "C:\Documents and Settings\a014579\Desktop\Copy of Test"
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
sDir = Dir$(sPath & "*.xlsx", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)
Exec_Sub Macro1()
'
' Macro1
'
' Keyboard Shortcut: Ctrl+m
'
Rows("2:2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$N$37").AutoFilter Field:=2, Criteria1:=".2"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
oWB.Save
oWB.Close False
sDir = Dir$
Loop
Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
I m having problm with this code
I m getting a error msg "COMPLIE ERROR_SUB OR FUNCTION NOT DEFINED"
.. cn u please help
...AJ...
On which line you get the error. Hope Exec_Sub Macro1 subroutine is available in the module/project
ReplyDeleteDo you know how to modify sPath code if the folder is within a Sharepoint document library and not on a file share?
ReplyDelete