Open Multiple XLSM files from a given Folder

A bit more information needed.

Is an identical macro run in all the files?

If so, then is that macro already in each of the files?

That will do for a start, further information may be needed depending on your replies to the above.

In that case it would be far simpler to have the macro in you Personal Workbook together with code that will open each file in the folder, run the code you already have, then save the file and close it.

Can you attach a sample file complete with the code that you already have.

I have looked through your code, I see that you select various parts of the URL in order to import the required data,

will the selection be the same for every file?

Quote

I have multiple XLSM files in a folder, which run the macro as soon the file is opened.

Do you mean each file has a Workbook_Open event code which calls the "HistoricalData" procedure?

OK

No need to stop the Workbook_Open code

Doing a code for you to test now.

Ignore my last reply! The Workbook_Open code does need to be stopped.

Instructions:

1. Copy this code into a new Module in your Personal Workbook

Sub UpdateAllFiles()
    Dim x, sInput As String, fName, ws As Worksheet
    
    sInput = InputBox("Enter Type, Start Date, End Date, Date Order, Output Type" & vbLf & _
                    "Leave a comma and a space between each, " & vbLf & _
                    "e.g. w, 1/1/2021, 1/7/2021, Descending, Table", "Data Entry")
    
    If Len(sInput) Then
        x = Split(sInput, ", ")
        fName = Dir("C:\Users\marks\Documents\") 'CHANGE this to the path to your folder
        
        While fName <> ""
            Set ws = Workbooks.Open(fName)
            With ws
                Call HistoricalData(x(0), x(1), x(2), x(3), x(4))
                .Close 1
            End With
            fileName = Dir
        Wend
    End If

End Sub

Sub HistoricalData(sType As String, DtS As Date, DtE As Date, sDtOrd As String, sOutput)

    Dim qurl As String, t As String
    
    With HistoricalSheet
    
    'BUILD THE URL A PIECE AT A TIME:
    qurl = "https://ichart.finance.yahoo.com/table.csv?"
    
    'ADD THE STOCK SYMBOL:
    qurl = qurl & "s=" & .Range("StockSymbol")
    
    'ADD THE DATA TYPE:
    Select Case sType
        Case "Daily Prices":    t = "d"
        Case "Weekly Prices":   t = "w"
        Case "Monthly Prices":  t = "m"
        Case "Dividends":       t = "v"
        Case "Splits":          t = "s"
    End Select
    
    'IF THE REQUEST IS FOR WEEKLY DATA, THIS LINE ALIGNS IT ONTO MONDAY BOUNDARIES
    'OTHERWISE ITS GOING TO ALIGN ONTO WHATEVER WEEKDAY THE StartDate IS ON
    If t = "w" Then DtS = DtS - Weekday(D) + 1
    
    qurl = qurl & "&a=" & Format(Month(DtS) - 1, "00") & _
                  "&b=" & Format(Day(DtS), "00") & _
                  "&c=" & Format(Year(DtS), "0000")
    
    qurl = qurl & "&d=" & Format(Month(DtE) - 1, "00") & _
                  "&e=" & Format(Day(DtE), "00") & _
                  "&f=" & Format(Year(DtE), "0000")
    
    
    qurl = qurl & "&g=" & t
    
    'Debug.Print qurl
    
    If sDtOrd = "Ascending" Then DateOrder = xlAscending Else DateOrder = xlDescending
       
    'CHANGE THE SHAPE COLOR AND TEXT:
    .Shapes("Shape1").Fill.ForeColor.RGB = RGB(0, 200, 0)
    .Shapes("Shape1").TextFrame.Characters.Text = "Asking for data..."
    
    
    'REQUEST THE DATA:
    If sOutput = "Table" Then
        t = EmulateURL(qurl, .Range("TableOrigin"), , DateOrder)
    Else
        'THE THIRD ARGUMENT IS THE LOCATION OF THE CSV, HERE WE OVERWRITE THE DATA, BUT YOU CAN GIVE IT ANY CELL E.G. "H12":
        t = EmulateURL(qurl, .Range("TableOrigin"), .Range("TableOrigin"), DateOrder)
    End If
    
    'LET THE USER KNOW IF THERE ARE ERRORS:
    If t <> "" Then MsgBox (t)
    
    .Shapes("Shape1").Fill.ForeColor.RGB = RGB(200, 0, 0)
    .Shapes("Shape1").TextFrame.Characters.Text = "Click to get historic data"
    
    
    Application.ScreenUpdating = True
    
    
    End With

End Sub

2. Copy JUST the 2 Functions from one of your files to the same Module

3. Remove existing code from each file (including the Workbook_Open code). If these are the only codes in each file

then you can change them to .xlsx instead of .xlsm

4. Run "UpdateAllFiles"

Note that there is no need to include quotation marks to the InputBox entries, but each entry must be cntered and separated by a comma and a space.

Did you include a back-slash at the end of the folder path?

If so, then please attach your file.

I sent you a PM in case your file contains sensitive data

I am attaching 2 files

The first ("FileConverter") will run through all your files in the folder and do the following:

1. Remove the button

2. Remove the Data Validation

3. Save the file as .xlsx

4. Completely delete the original .xlsm file

This will just be a one-off run but should save you a ton of time rather than making those 4 changes on 400 files manually!

The second is the Controller file I mentioned. Complete the required criteria in cells D5 to D9 (none can be left empty!) then click the button.

The code will loop through all the files in a folder and update them according to the entered criteria. It will take a bit of time to update all 400 files, so you can go for a coffee break and leave it churning away! There will be a message when the code completes telling you how many files out of the total file count have been updated.

I have tested various different criteria and all works except for "Dividends" & "Splits", but I notice that fails on the Sample file you sent.

I have left your existing code much as it was, just change the indentation, and modified the variables where necessary. I also added a bit to the error message box so that it shows the file name where the error occurred.

I suggest you copy 6 or so files to a new folder and run tests on those before running the code on all 400 files.