在线等，请大神指点错在哪里，批量去除文件夹内文件的密码

洞房不败

大神看一下


一个文件夹里面的 Excel文件全部加密的，默认密码是123456；请求全部去除密码

Sub UnprotecAll()
On Error Resume Next
Application.DisplayAlerts = False
Dim my_Link As String
Dim my_Doc As String
Dim i As Single
i = 0
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
my_Link = .SelectedItems(1)
End With
my_Doc = Dir(my_Link & "\" & "*.xls*")
Do While Len(my_Doc) <> 0
Workbooks.Open Filename:=my_Link & "\" & my_Doc, Password:="123456"
ActiveWorkbook.Unprotect ("123456")
ActiveWorkbook.Save
ActiveWorkbook.Close
i = i + 1
my_Doc = Dir
Loop
MsgBox "共去除密码共" & i & "个文件"
End Sub


这个无法使用哪里出了问题

Sub xx()     Dim pth, fn, i, j, n     pth = ThisWorkbook.Path & "\"     fn = Dir(pth & "*.xls")     Do While fn <> ""       If fn <> ThisWorkbook.Name Then         Application.Workbooks.Open pth & fn         n = Workbooks(fn).Sheets.Count         For j = 1 To n           Workbooks(fn).Sheets(j).Unprotect "123456"         Next         Application.Workbooks(fn).Close True       End If       fn = Dir     Loop End Sub 两个方案哪里出现问题了？

洞房不败

Sub xx()
    Dim pth, fn, i, j, n
    pth = ThisWorkbook.Path & "\"
    fn = Dir(pth & "*.xls")
    Do While fn <> ""
      If fn <> ThisWorkbook.Name Then
        Application.Workbooks.Open pth & fn
        n = Workbooks(fn).Sheets.Count
        For j = 1 To n
          Workbooks(fn).Sheets(j).Unprotect "123456"
        Next
        Application.Workbooks(fn).Close True
      End If
      fn = Dir
    Loop
End Sub

洞房不败

在线等，急，请高人指点

洞房不败

请大家上传一个EXCEL 我放在文件夹直接运行宏

洞房不败

有没有高人指点啊·····