Sum Mulitple Passworded Workbooks

[jtodd]

HI , I have been asked to analyse some data , the problem is that it is in 52 files ( one for each week)
I know it would have been best to put all in one workbook but i did not design it and will be changing it)
All the workbooks are the same structure and all have the same password .

is there a way of removing the password from all in one go - or
is there a way of combining the data from the workbooks with out having to enter the password for each workbook- or
am i stuck with opening each one and saving without password ?

they are also still using exell 97 !!!!!!!!! ( will be updating to 2019 but have to work with this data for this year)

 

[mohadin]

Hi
Have a look at this might helps

Want to change password on multiple workbooks

I need to give access to all my Excel 2003 workbooks (100's of files and my job is surplus to requirements:cry:). I always used one of two passwords on all workbooks for both file Open and WriteRes. However I don't want to give my passwords (which would be the simplist solution). What I would...

www.mrexcel.com

 

[mohadin]

Give this a try

Sub X_Pasw()
    Dim fDialog As FileDialog
    Dim wb As Workbook
    Dim fPath As Variant
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Select the files for removing PSW"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xlsm"    '<< change to suitable extention
        If .Show = True Then
            Application.DisplayAlerts = False
            Application.ScreenUpdating = False
            For Each fPath In .SelectedItems
                Set wb = Workbooks.Open(Filename:=fPath, Password:="YOUR PASSWORD")    '<< to be changed to...
                ActiveWorkbook.SaveAs Filename:=fPath, Password:="", WriteResPassword:=""
                ActiveWorkbook.Close savechanges:=True
            Next
        End If
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Job Done"
End Sub