取消对指定路径中Excel工作簿的保护，刷新工作簿连接，然后保护工作簿

Question

我想使用相同的密码取消对指定路径中excel工作簿的保护。我使用了下面的代码来完成这个过程。

Sub Unlock_Refresh()
Dim path As String, w As Worksheet, pass As String, wb As Workbooks
pass = "1519"
Worksheets("Sheet2").Select
path = Worksheets("Sheet2").Range("A1").Value
For Each wb In path
wb.Unprotect Password:=pass
Next wb
ThisWorkbook.RefreshAll
Application.Wait ("00:00:10")
For Each wb In path
wb.Protect Password:=pass
Next wb
End Sub

这行不通。有人能帮我吗。

Answer 1

Application.Wait ("00:00:10")暂停宏直到午夜过后10秒，我想这不是你想要的。使用Dir迭代目录中的文件，打开工作簿，刷新、关闭和保存。

Sub Unlock_Refresh()
Dim wb As Workbook, ws As Worksheet
Dim Filepath As String, Filename As String
Dim n As Long
Dim books As New Collection

Const pass = "1519"
Filepath = Worksheets("Sheet2").Range("A1").Value
If Right(Filepath, 1) <> "" Then Filepath = Filepath & ""

Filename = Dir(Filepath & "*.xls*")
Application.ScreenUpdating = False
Do While Filename <> ""
n = n + 1
Set wb = Workbooks.Open(Filepath & Filename, Password:=pass)
books.Add wb, CStr(n)
Filename = Dir
Loop
ThisWorkbook.RefreshAll
Application.Wait Now + TimeValue("00:00:10")

' close books
For Each wb In books
wb.Close SaveChanges:=False
Next

Application.ScreenUpdating = True
MsgBox n & " workbooks opened and refreshed " & vbLf & Filepath, vbInformation

End Sub