Question

我在发送电子邮件之前尝试检查所有附件，看看它们是否受密码保护。通常这些将是Word，Excel或PowerPoint文件。

我已经知道是否有附件。

我不知道如何遍历邮件文件中的每个附件，看看每个附件是否受密码保护。

Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim attachments2 As Outlook.attachments
Dim attachm As Outlook.Attachment

If Item.attachments.Count > 0 Then

    Set attachments2 = Item.attachments

    Set attachm = Item.Attachment

    For Each attachm In attachments2

    ' ***IM GUESSING CODE TO CHECK IF ATTACHMENTS ARE PROTECTED WOULD GO IN HERE?***

    Next

End If

End Sub

Answer 1

以下代码不能解决您的问题，但会显示如何检查文档和数据库以查看是否受密码保护。如果您能够获取文件路径，则可以修改此代码以传递路径和文件名，然后返回一个标志以指示PW状态。或者只是修改并在您的模块中嵌入此代码。

修订版1：替代尝试查找文件的路径以检查密码，替代解决方案是将代码保存到临时文件夹，然后在完成时删除。以下代码行将为您提供临时文件夹（即C：\ Users \ MyName \ AppData \ Local \ Temp）

strFolder = objFSO.GetSpecialFolder(2)

这个想法来自一个允许您重命名附件的帖子：http://www.flobee.net/rename-outlook-attachments-before-you-send-them/

此外，OP需要考虑如何实施/执行密码检查。如果代码被“自动”调用，那么除非您有一些规则只检查某些文件，否则您的代码将始终检查所有电子邮件的所有附件！我怀疑这是你想要发生的事情。也许是工具栏上的用户按钮？

原始代码：

Option Compare Database
Option Explicit

Public Function Check_For_Passwords()
Dim objWord     As Word.Application
Dim objWordDoc  As Word.Document
Dim sPath       As String
Dim sFileName   As String
Dim oAccess     As Access.Application

    On Error GoTo Error_Trap

    ' Set the following string to the path of your Word Document
    sPath = "C:\data\WP\"                   ' <<< CHANGE THIS!!
    sFileName = "Access.doc"                ' <<< CHANGE THIS!!
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False
    ' Use a fake password - if no password on doc, OK; If password protected will fail
    Set objWordDoc = objWord.Documents.Open(sPath & sFileName, , True, , "*****")
    'Err: 5408    The password is incorrect. Word cannot open the document.

    Set oAccess = CreateObject("Access.Application")
    oAccess.Visible = False
    sPath = "C:\data\Access\"                   ' <<< CHANGE THIS!!
    sFileName = "PWD_DB.mdb"                    ' <<< CHANGE THIS!!

    'If error, then database has password
    oAccess.DBEngine.OpenDatabase sPath & sFileName, False
    'Err: 3031    Not a valid password.

    Exit Function

Error_Trap:
    If Err.Number = 5408 Then
        MsgBox "Document has a password! Do whatever...  " & sPath & sFileName
    ElseIf Err.Number = 3031 Then
        MsgBox "Access DB has a password! Do whatever...  " & sPath & sFileName
    Else
        MsgBox "Unexpected error: " * Err.Number & vbTab & Err.Description
    End If
End Function

发送前检查电子邮件附件是否受密码保护

1 个答案: