PDA

View Full Version : Open workbook with one password close with another from a list??



N1ck9141
04-26-2016, 07:27 AM
Hi, so i have a script for tidying up some excel files. it opens the files based on there name which is a list in column A of an excel worksheet. And a fixed password they all share
It removes all blank columns in the file, ignoring the title row (row 1) just blank data rows (row 2 to end).
and closes the files.

This issue is, I want it to close the file with a new password which is stored in column B (next to the name and changes as you go down column B) as the result of a V-lookup.

this is the code i have.


Sub TidyFiles() 'remove columnsDim lngROW As Long, lngCOL As Long
Dim rng As Range, rngFILE As Range
Dim ws As Worksheet, wsList As Worksheet
Dim wb As Workbook, wb2 As Workbook
Dim strFPATH As String, strFNAME As String
Dim arrFILES As Variant, varI As Variant
Dim arrPWORD As Variant


'************************************************************************** *****************
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wb = ThisWorkbook
Set wsList = ActiveSheet
strFPATH = "C:\Files"
lngROW = Range("A" & wsList.Rows.Count).End(xlUp).Row
arrFILES = Range(wsList.Cells(1, 1), wsList.Cells(lngROW, 2)).Value
arrPWORD = Range(wsList.Cells(2, 1), wsList.Cells(lngROW, 2)).Value

'************************************************************************** *****************
For Each varI In arrFILES
strFNAME = strFPATH & "\" & varI & ".xls"
Set wb2 = Workbooks.Open(strFNAME, Password:="passwordbefore")
Set ws = ActiveSheet
lngCOL = 53
With ws
Do Until lngCOL = 1
lngROW = Cells(.Rows.Count, lngCOL).End(xlUp).Row
If lngROW <= 1 Then
Set rng = Cells(1, lngCOL)
rng.EntireColumn.Delete
'************************************************************************** *****************
End If
lngCOL = lngCOL - 1
Loop
ws.Protect arrPWORD, True, True 'new password on close
End With

wb2.Close True
Next varI
'************************************************************************** *****************
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Can anyone assist I have tried a few different techniques like

ws.Protect (Password:= arrPWORD)

and tried including it lower in script just before the close.


ws.Protect arrPWORD, True, True 'new password on close
wb2.Close True

Have even tried changing the type so arrPWORD is a string


Dim arrFILES As Variant, varI As Variant
Dim arrPWORD As String

but continue to get different errors through each try.

Can anyone help? Thank you in advance. :think: