Question

我正在尝试将数据从受密码保护的工作表复制到另一个工作簿，在该工作簿中我必须合并多个工作表，而我要复制的工作簿受到密码保护，

所以我也以打开文件的语法输入了密码，但是仍然提示输入相同的密码，我也尝试了Rewritepassword语法，但是仍然提示

Sub GetSheets()
'Updated by Extendoffice 2019/2/20
    Path = "D:\My Path\"
    Filename = Dir(Path & "*.xlsx")
    Do While Filename <> ""
     If (Filename = "scenarios.xlsx") Then
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
        Workbooks.Open Filename:=Path & Filename, Password:="*****", 
                  WriteResPassword:="****", ReadOnly:=True
        Application.AskToUpdateLinks = True
        Sheets("Data").Copy After:=ThisWorkbook.Sheets(1)
        Workbooks(Filename).Close
        If ActiveSheet.AutoFilterMode Then
            ActiveSheet.AutoFilterMode = False
        End If
     End If
     Filename = Dir()
    Loop
End Sub


The password to unlock workbook is same as the other passwords that are popping up

Answer 1

请注意，Password中的Workbooks.Open参数只是打开/查看文件所需的密码，它与工作簿/工作表的保护无关。如果工作簿/工作表受到保护，那么您可能仍需要使用...

Workbook.Unprotect method取消保护工作簿
Worksheet.Unprotect method取消对工作表的保护

还请注意，如果您无需输入密码即可打开文件进行查看，那么您一定不能在Password中指定Workbooks.Open参数（否则它将不断要求输入正确的密码，实际上是没有）。

进一步的改进：

我建议远离ActiveSheet
使用Option Explicit强制进行正确的变量声明，并将打开的工作表设置为变量，以便以后可以将其用于依赖此工作簿的进一步操作。
如果您关闭.DisplayAlerts = False，则应稍后重新激活它，否则它将一直保持关闭状态，直到关闭Excel。
您无需循环检查文件scenarios.xlsx是否存在

所以我认为它应该看起来像这样：

Option Explicit

Private Const PASSWD As String = "yourpasswordhere" 'define your password only once

Public Sub GetSheets()
'Updated by Extendoffice 2019/2/20
    Dim Path As String
    Path = "D:\My Path\"

    Dim Filename As String
    Filename = Dir(Path & "scenarios.xlsx") 'check if file exists

    If Filename <> vbNullString
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False 'comment out this line for Debugging (or you don't see if something goes wrong

        Dim wbScenarios As Workbook
        Set wbScenarios = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)

        Application.AskToUpdateLinks = True

        'unprotect workbook and/or worksheet (test which one you need or if you need both)
        wbScenarios.Unprotect Password:=PASSWD 'defined on top of the module
        wbScenarios.Worksheets("Data").Unprotect Password:=PASSWD 'defined on top of the module

        wbScenarios.Worksheets("Data").Copy After:=ThisWorkbook.Sheets(1)
        wbScenarios.Close SaveChanges:=False

        'if you insert after sheet 1 then your inserted sheet is Sheets(2)
        If ThisWorkbook.Sheets(2).AutoFilterMode Then
            ThisWorkbook.Sheets(2).AutoFilterMode = False
        End If
    End If

即使在命令行输入密码后，仍然提示输入密码

1 个答案: