I found a couple of minor problems. Try these updates

Sub openfiles()

Application.Wait "21:00:00"

Dim Bks() As Variant

BookCount = 0
With ThisWorkbook.Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) < ""
Folder = .Range("A" & RowCount)
FName = Dir(Folder & "\*.xls")
'get base name of folder
BaseName = Folder
Do While InStr(BaseName, "\") 0
BaseName = Mid(BaseName, InStr(BaseName, "\") + 1)
Loop

Do While FName < ""

'get password
With ThisWorkbook.Sheets("PassWd")
'remove xls from filename
BFName = Left(FName, InStr(FName, ".") - 1)
PassWdRowCount = 2
Do While .Range("A" & PassWdRowCount) < ""
If .Range("B" & PassWdRowCount) = BaseName And _
.Range("A" & PassWdRowCount) = BFName Then

BkPassword = .Range("C" & PassWdRowCount)
Exit Do
End If

PassWdRowCount = PassWdRowCount + 1
Loop
End With

BookCount = BookCount + 1
ReDim Preserve Bks(BookCount)
Set Bks(BookCount - 1) = _
Workbooks.Open(Filename:=Folder & "\" & FName, _
Password:=BkPassword)
FName = Dir()
Loop
RowCount = RowCount + 1
Loop
End With

Application.Wait "22:00:00"

For i = 0 To (BookCount - 1)
Bks(i).Close savechanges:=False
Next i
End Sub


"Max" wrote:

I've got a bunch of .xls files in a folder, like this

D:\Campaign Sys (main folder)
-- C001 (subfolder)
-------- Br001 (subfolder)
---------------RM01_C001.xls
---------------RM02_C001.xls
-------- Br002 (subfolder)
---------------RM03_C001.xls
---------------RM04_C001.xls
etc

In Sheet1,
I've listed all the folder paths in A2 down:
D:\Campaign Sys\C001\Br001
D:\Campaign Sys\C001\Br002
etc

In another sheet named: Passwd
I've got the list of passwords* in cols A to C
data from row2 down
*passwords to open are listed in C2 down

RM Branch Pwd
RM01 Br001 1111
RM02 Br001 1112
RM03 Br002 1113
RM04 Br002 1114
etc

For daily updating purposes,
I need to run a sub to open all the .xls files
in all the folder paths at 9.00 pm daily
and then to close all files w/o saving an hour later at 10 pm

Appreciate any help to achieve the above. Thanks