VBA PathFile Directory & Remove Password

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
211
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

Can you possibly help me tweak this code? I'm thinking in Sheet1, I'll put the pathfile link in Cell F1 then Password in Cell F2. Also, how to avoid getting error when the file is in read-only format.

= = = = = =
Sub PasswordRemover()

Dim wBook As Workbook
Dim strFilename As String
'Const fPath As String = "C:\Users\Documents\"
Const strPassword As String = "12345ABC&D" 'case sensitive
Const strEditPassword As String = "12345ABC&D" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc

While Len(strFilename) <> 0
Application.DisplayAlerts = False
Set wBook = Workbooks.Open(Filename:=fPath & strFilename, _
Password:=strPassword, _
WriteResPassword:=strEditPassword)
'ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite

wBook.SaveAs Filename:=fPath & strFilename, CreateBackup:=False, WriteResPassword:="", Password:="" ', ReadOnlyRecommended:=False

wBook.Close 0
Application.DisplayAlerts = True
strFilename = Dir$()
Wend


End Sub


Any thoughts will be much appreciated.

Thank you!
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows
I assume that all the Workbooks have a sheet named "Sheet1" and that if the file is read-only, to SKIP it. (Excel Workbook files can show up as read only when you try to open them when they are already opened.) Then the following may be what you want. (Just let us know . . . I didn't run this code, BTW.)
VBA Code:
Sub PasswordRemover()

Dim wBook As Workbook
Dim strFilename As String
'Const fPath As String = "C:\Users\Documents\"
Const strPassword As String = "12345ABC&D" 'case sensitive
Const strEditPassword As String = "12345ABC&D" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc

'Application.DisplayAlerts = False
While Len(strFilename) <> 0
    If GetAttr(fName) And vbReadOnly <> 1 Then 'If it's read only, skip it.
        Set wBook = Workbooks.Open(fileName:=fPath & strFilename, Password:=strPassword, WriteResPassword:=strEditPassword)
        'ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
        With wBook
            .Sheets("Sheet1").Range("F1").Value = fPath & strFilename
            .Sheets("Sheet1").Range("F2").Value = strPassword
            .SaveAs fileName:=fPath & strFilename, CreateBackup:=False, WriteResPassword:="", Password:="" ', ReadOnlyRecommended:=False
            .Close 0
        End With
        strFilename = Dir$()
    End If
Loop
'Application.DisplayAlerts = True

End Sub
 

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
211
Office Version
  1. 2016
Platform
  1. Windows
Tha
I assume that all the Workbooks have a sheet named "Sheet1" and that if the file is read-only, to SKIP it. (Excel Workbook files can show up as read only when you try to open them when they are already opened.) Then the following may be what you want. (Just let us know . . . I didn't run this code, BTW.)
VBA Code:
Sub PasswordRemover()

Dim wBook As Workbook
Dim strFilename As String
'Const fPath As String = "C:\Users\Documents\"
Const strPassword As String = "12345ABC&D" 'case sensitive
Const strEditPassword As String = "12345ABC&D" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc

'Application.DisplayAlerts = False
While Len(strFilename) <> 0
    If GetAttr(fName) And vbReadOnly <> 1 Then 'If it's read only, skip it.
        Set wBook = Workbooks.Open(fileName:=fPath & strFilename, Password:=strPassword, WriteResPassword:=strEditPassword)
        'ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
        With wBook
            .Sheets("Sheet1").Range("F1").Value = fPath & strFilename
            .Sheets("Sheet1").Range("F2").Value = strPassword
            .SaveAs fileName:=fPath & strFilename, CreateBackup:=False, WriteResPassword:="", Password:="" ', ReadOnlyRecommended:=False
            .Close 0
        End With
        strFilename = Dir$()
    End If
Loop
'Application.DisplayAlerts = True

End Sub
Thanks for this. I do wanted to omit his code and put it on the cell as mention.

Const strPassword As String = "12345ABC&D" 'case sensitive
Const strEditPassword As String = "12345ABC&D" 'If no password use ""

Appreciate your help. :)
 

Forum statistics

Threads
1,148,159
Messages
5,745,116
Members
423,925
Latest member
globaltlg

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top