Macro works for one file, does not work for all files in the directory

[chris1979]

Hi
I have around 50 files in the directory. I want macro to open the files one by one and run the macro saved in all files. Below is the code I have.,.....it opens one file, runs the macro and closes. it does not open any files listed in the directory.

Please assist.



Sub OpenAndRunMacro()
Dim wb As Workbook
Dim folderPath As String
Dim filename As String

' Disable alerts to prevent pop-up windows
Application.DisplayAlerts = False

' Define the folder path
folderPath = "C:\Users\C.ABC\OneDrive - ABC\Current_Week\"

' Check if the folder exists
If Dir(folderPath, vbDirectory) <> "" Then
' Loop through each file in the folder
filename = Dir(folderPath & "*.xls*")
Do While filename <> ""
' Open the workbook
Set wb = Workbooks.Open(folderPath & filename)

' Run the macro if it exists
On Error Resume Next
Application.Run "'" & wb.Name & "'!CopyAndPasteStock"
On Error GoTo 0

' Close the workbook without saving changes
wb.Close False

' Get the next filename
filename = Dir
Loop
Else
MsgBox "Folder not found!"
End If

' Enable alerts back
Application.DisplayAlerts = True

MsgBox "Process completed."
End Sub

 

[Trebor76]

Hi Chris,

The code looped through the Excel files for me in one of my directories so that part if fine. If you comment out "On Error Resume Next" and try again what happens?

Robert

 

[myall_blues]

You are missing the brackets on the second Dir statement

' Get the next filename
filename = Dir()
Loop

Regards

Murray

 

[Trebor76]

You are missing the brackets on the second Dir statement

It worked for me without the parentheses

As the two arguments the DIR function uses are both optional DIR will work fine but it is probably the convention to use DIR()

 

[myall_blues]

It worked for me without the parentheses

As the two arguments the DIR function uses are both optional DIR will work fine but it is probably the convention to use DIR()

Apologies you are correct.

 

[myall_blues]

@chris1979 perhaps you could try a simplified version and let us know your result.

Option Explicit
Sub test()
    Dim folderpath As String, Filename As String
        
    ' Define the folder path
    folderpath = "C:\Users\C.ABC\OneDrive - ABC\Current_Week\"
    
    ' Check if the folder exists
    If Dir(folderpath, vbDirectory) <> "" Then
        ' Loop through each file in the folder
        Filename = Dir(folderpath & "*.xls*")
        Do While Filename <> ""
            Debug.Print Filename
            ' Get the next filename
            Filename = Dir
        Loop
    End If
End Sub

 

[Trebor76]

Apologies you are correct.

Don't be sorry. You're giving up your time to help someone for free. You should be thanked

 

[chris1979]

Thank you very much for your time and effort

I did try running the above code and I got this result in the window. The code is recognizing that there are files in the drive

I have changed the drive from onedrive to local hard drive. It did not work
I have checked the file one by one, the macro does exist and running manually
This macro only runs the first file and stops

Please assist

 

[Alex Blakenburg]

You seem to be taking a very unusual approach, why are you keeping the macros in the individual workbooks ?
That is a very high maintenance approach. Typically you would run the macro from the initiating workbook.
Are there major differences in the macros in each workbook ?

Have you stepped through the code using <F8> ? Are the other workbooks not opening OR are the macros not running OR are the macros continually copying the data over the top each other ? (if you look at the first few rows of your result sheet are they from the first or the last workbook)

Perhaps show us what the macro you are calling looks like.

 

[chris1979]

Hi Alex
I have tried that approach as well (write the code in the initiative workbook). Now in the initiating WB.... it opens the file (not all but some) but does not run the macro CopyAndPasteStock which exists in Module 2 in the initiating workbook

Macro in initiating WB

Sub OpenAndRunMacro_2()
Dim wb As Workbook
Dim folderPath As String
Dim fileName As String

' Disable alerts to prevent pop-up windows
Application.DisplayAlerts = False

' Define the folder path
folderPath = "C:\Users\ABC\OneDrive - ABC Ltd\Current_Week_WISR\"

' Check if the folder exists
If Dir(folderPath, vbDirectory) <> "" Then
' Loop through each file in the folder
fileName = Dir(folderPath & "*.xlsm")
Do While fileName <> ""
' Open the workbook
Set wb = Workbooks.Open(folderPath & fileName)

' Run the macro if it exists
On Error Resume Next
Application.Run "'" & wb.Name & "'!CopyAndPasteStock"
On Error GoTo 0

' Save changes to the workbook
wb.Save

' Close the workbook with saving changes
wb.Close True

' Get the next filename
fileName = Dir()
Loop
Else
MsgBox "Folder not found!"
End If

' Enable alerts back
Application.DisplayAlerts = True

MsgBox "Process completed."
End Sub


CopyAndPasteStock Macro in Module in the same initiative WB

Sub CopyAndPasteStock()
'This vba will copy and paste the closing stock as opening stock for the upcoming week, delete the existing data, change the date in B1 to next Tuesday and protect the file

Dim sourceRange As Range
Dim destinationRange As Range
Dim stockSheet As Worksheet
Dim password As String

' Set the source range (L4:L111)
Set sourceRange = Sheets("Stock").Range("L4:L111")

' Set the destination range (C4:C111) in the "Stock" sheet
Set stockSheet = Sheets("Stock")
Set destinationRange = stockSheet.Range("C4:C111")

' Unprotect the workbook with the password "superstar"
Set ws = Sheets("Stock")
ws.Unprotect "superstar"

' Copy the data from the source range to the destination range
sourceRange.Copy
destinationRange.PasteSpecial xlPasteValues

' Set the ranges to be deleted (D4:J111 and L4:L111)
Set deleteRange1 = stockSheet.Range("D4:J111")
Set deleteRange2 = stockSheet.Range("L4:L111")
Set deleteRange3 = stockSheet.Range("P5:V5")
Set deleteRange4 = stockSheet.Range("P6:U6")
Set deleteRange5 = stockSheet.Range("P14:P15")
Set deleteRange6 = stockSheet.Range("M4:M111")
Set deleteRange7 = stockSheet.Range("P8:V8")

deleteRange1.ClearContents
deleteRange2.ClearContents
deleteRange3.ClearContents
deleteRange4.ClearContents
deleteRange5.ClearContents
deleteRange6.ClearContents
deleteRange7.ClearContents

stockSheet.Range("B1").Formula = "=IF(MOD(A2-1,7)>2,A2+2-MOD(A2-1,7)+7,A2+2-MOD(A2-1,7))"
stockSheet.Range("B1").Value = stockSheet.Range("B1").Value


' Protect the workbook with the same password
stockSheet.Range("B1").Locked = True
stockSheet.Range("C4:C111").Locked = True
Set ws = Sheets("Stock")
ws.Protect "superstar"

' Save and close the workbook
ThisWorkbook.Save
ThisWorkbook.Close
End Sub