VBA

Question

有没有办法在尝试打开工作簿之前检查它是否受到保护。

这是我的代码，但我不知道方法（如果可能的话）

Sub MySub() Dim Wb As Workbook For i = 14 To Cells(Rows.Count, 1).End(xlUp).Row 'I Would like to check if the workbook is Protected here Set Wb = GetObject(Cells(i, 4).Value) Wb.Open End Sub

注意： 在此代码中 Cells(i,4).Value 将等于工作簿路径..

Answer 1

也许这不能让您完全满意，但也许能帮上一点忙。

Sub checkif()

On Error GoTo ErrHand

    Dim obj As Object
    Dim strFileName

    strFileName = "filepath"

    Set obj = Workbooks.Open(strFileName, , , , "")

    Exit Sub
ErrHand:

    If Err() = 1004 Then
        MsgBox "Protected"
    End If

End Sub

Answer 2

对此进行了更多思考并提出了以下建议 - 尽管需要进行更多测试并且可能需要进行一些修改。我不喜欢默认结果是它受到保护，但在我的快速测试中，我只能得到一个不受保护的文件来列出它的项目。

它的工作原理是将文件转换为 zip 文件，尝试浏览其内容，然后再转换回原始类型。我只用 xlsx 文件测试过它，但 xlsm 的原理也应该相同。转换后，我使用 shell 来浏览 zip 内容。未受保护的文件将 return 其内容列表，而受保护的文件则不会。

Public Function IsWorkbookProtected(WorkbookPath As String) As Boolean
    Dim fileExtension As String
    Dim tmpPath As Variant
    Dim sh As Object
    Dim n

    fileExtension = Right(WorkbookPath, Len(WorkbookPath) - InStrRev(WorkbookPath, "."))
    tmpPath = Left(WorkbookPath, InStrRev(WorkbookPath, ".")) & "zip"

    Name WorkbookPath As tmpPath

    Set sh = CreateObject("shell.application")
    Set n = sh.Namespace(tmpPath)

    IsWorkbookProtected = Not n.Items.Count > 0

    Name tmpPath As WorkbookPath

End Function

使用

调用

Sub test()
    Dim FolderPath As String
    Dim fPath1 As String, fPath2 As String

    FolderPath = "ParentFolder"

    ' protected
    fPath1 = FolderPath & "\testProtection.xlsx"
    ' unprotected
    fPath2 = FolderPath & "\testProtection - Copy.xlsx"

    Debug.Print fPath1, IsWorkbookProtected(fPath1)
    Debug.Print fPath2, IsWorkbookProtected(fPath2)
End Sub

立即输出window:

ParentFolder\testProtection.xlsx     True
ParentFolder\testProtection - Copy.xlsx   False

这是对探索问题的简短测试，我要声明这很可能不是决定性的，也不是万无一失的答案。理想情况下，我想遍历 zip 文件夹内容并测试 'EncryptedPackage' 但 NameSpace 没有 returning 任何项目。可能还有另一种方法可以做到这一点，但我还没有进一步调查。

受保护的 Excel 文件 zip 内容：

无保护 Excel 文件 zip 内容：

更新计时器测试

使用来自TheSpreadSheetGuru

的计时器代码

Sub CalculateRunTime_Seconds()
    'PURPOSE: Determine how many seconds it took for code to completely run
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    'Remember time when macro starts
      StartTime = Timer

'    Debug.Print "IsWorkbookProtected"
    Debug.Print "testOpen"

    '*****************************
    'Insert Your Code Here...
    '*****************************
'    Call testZip
    Call testOpen

    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)

    'Notify user in seconds
      Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds"

End Sub

并使用以下代码通过打开文件、测试保护和关闭来进行测试

Sub testOpen()
    Dim wb As Workbook
    Dim FolderPath As String
    Dim fPath1 As String, fPath2 As String
    Dim j As Long

    FolderPath = "FolderPath"

    Application.ScreenUpdating = False
    ' protected
    fPath1 = FolderPath & "\testProtection.xlsx"
    ' unprotected
    fPath2 = FolderPath & "\testProtection - Copy.xlsx"
    For j = 1 To 2

        On Error Resume Next
        Set wb = Workbooks.Open(Choose(j, fPath1, fPath2), , , , "")

        Debug.Print Choose(j, fPath1, fPath2), wb Is Nothing

        wb.Close
        On Error GoTo 0
    Next j

    Application.ScreenUpdating = True

End Sub

我得到了以下次数：

运行多次并得到相似的结果

Answer 3

这完全不受任何文档的支持，但我想我发现了一些有趣的东西。我很好奇其他对此的看法。

假设

所以，每次我检查所有文件属性时，有一个属性在文件受密码保护时似乎发生了变化，这是属性 42（即 "程序名")，扩展文件属性的一部分。请参见下面的屏幕截图（来自@Tom），其中左侧是未受保护的文件，右侧是受保护的文件。

每次取消保护工作簿时，都会显示一个值，例如“Microsoft Excel”，有时甚至是“Microsoft Excel Online”。但是，在我保护工作簿的所有情况下，该值都是空的。因此，这让我想到查看这个特定的属性以某种方式告诉我们当属性为空时文件受到保护。这可能是因为属性由于保护而无法读取？

在@Tom 的帮助下，我们发现属性的索引可能不同。虽然在我的系统上这个属性的索引为 42，但在 Tom 的系统中它似乎低于 8。因此他在循环文件之前好心地实现了一个智能循环 return 正确的索引。值得注意的是：属性的名称取决于语言！例如，对于荷兰语，我会查找“Programmanaam”。

代码

使用以下代码，我们可以遍历特定文件夹并循环文件到 return 这个特定属性的值：

Sub MySub()

Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir:   Set oDir = oShell.Namespace("C:\Users\...\")
Dim i as long, x as long

For i = 0 To 288
    If oDir.GetDetailsOf(oDir.Items, i) = "Program name" Then
        x = i
        Exit For
    End If
Next i

For Each sFile In oDir.Items
    If oDir.GetDetailsOf(sFile, x) = "" Then
        Debug.Print sFile.Name & " is protected"
    Else
        Debug.Print sFile.Name & " is unprotected and can be openened"
    End If
Next

End Sub

为了进一步调整以循环范围并检查一堆工作簿名称，可能如下所示：

工作代码如下：

Sub MySub()

Dim MainPath As String: MainPath = "C:\Users\...\"
Dim i As Long, x As Long
Dim oDir As Object: Set oDir = CreateObject("Shell.Application").Namespace(CStr(MainPath))

'Get the right index for property "Program Name"
For i = 0 To 288
    If oDir.GetDetailsOf(oDir.Items, i) = "Program Name" Then
        x = i
        Exit For
    End If
Next i

'Loop the range of workbooks and check whether or not they are protected
With ThisWorkbook.Sheets("Sheet1") 'Change accordingly
    For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If oDir.GetDetailsOf(oDir.Items.Item(CStr(.Cells(i, 1))), x) = "" Then
            Debug.Print .Cells(i, 1) & " is protected"
        Else
            Debug.Print .Cells(i, 1) & " is unprotected and can be openened"
            'Open your workbook here?
        End If
    Next i
End With

End Sub

Note: Please notice the use of Cstr() on both the MainPath and the cell's value. It's as far as I know not very clear why, but without it, the code will return an 'Error 445: Object doesn't support this action' Update: Check question for some more insight on this specific issue.

示例

例如，我有以下工作簿，其中 Map2 和 Map5 受保护：

第一个宏运行之后立即 window：

接下来我只保护了map1和map3，结果如下：

结论

假设得到证实？我不知道，但就我而言，这个假设从未被证明是错误的。同样，没有关于此的文档。但这可能只是您快速了解工作簿是否受保护的方式。

顺便说一句，我借用了一些代码形式 here

Answer 4

我想建议的是使用文件签名，这是一种神奇的字节串，除了文件扩展名外，还可以帮助操作系统和程序确定它们正在处理的内容。根据可信的 TrID 数据库，定义加密 Excel 文件（又名 'Encrypted OLE2 / Multistream Compound File'）的魔法字符串由以下八个字节组成：D0 CF 11 E0 A1 B1 1A E1.

了解这一点后，我们可以按如下方式检查它们是否存在：

Public Function IsPasswordProtected(strFilePath As String) As Boolean
    ' Open file for byte reading, check length
    Dim fileInt As Integer: fileInt = FreeFile
    Open strFilePath For Binary Access Read As #fileInt
    If LOF(fileInt) < 8 Then
        Exit Function
    End If
    
    ' Fetch the first bytes
    Dim arrFile(0 To 7) As Byte
    Get #fileInt, , arrFile
    Close #fileInt
    
    ' Compare with Encrypted OLE2 / Multistream Compound File magic
    ' D0 CF 11 E0 A1 B1 1A E1
    Dim arrSignature(0 To 7) As Byte, i As Integer
    For i = LBound(arrSignature) To UBound(arrSignature)
        arrSignature(i) = Choose(i + 1, &HD0, &HCF, &H11, &HE0, &HA1, &HB1, &H1A, &HE1)
    Next
    If StrConv(arrFile, vbUnicode) = StrConv(arrSignature, vbUnicode) Then
        IsPasswordProtected = True
    End If
End Function

请注意以上内容不包含正确的错误处理。另外，请记住，签名也与未受保护的 XLS 文件共享，因此只能得出 XLSX 文件的正确结论。

VBA - 在打开工作簿之前检查它是否受保护

VBA - Check if a workbook is protected before open it

excel

password-protection