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

Question

发送邮件时，我想检查附件，特别是MS Word，Excel和PowerPoint，以查看它们是否受密码保护。如果不是，则触发提示以通知用户并提供取消选项。

我确实找到了以下内容-Check if email attachment is password protected before sending。它仅涵盖Excel工作簿和Access数据库。

编辑-我已经可以处理Excel附件了。我在为PowerPoint附件苦苦挣扎。问题是打开一个有密码的PowerPoint文件。第一部分中使用的Excel方法返回以下错误

  

运行时错误'-2147467259（80004005）'：
  对象“演示文稿”的方法“打开”失败

我的代码如下：

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

Dim objAtt As Outlook.Attachment
Dim answer As Integer

'Cancel if there are no attachments
If Item.Attachments.Count = 0 Then
  Exit Sub
Else
  'identify Excel files
  For Each objAtt In Item.Attachments
    If LCase(Right(objAtt.FileName, 4)) = "xlsx" Or _
      LCase(Right(objAtt.FileName, 3) = "xls") Or _
      LCase(Right(objAtt.FileName, 4) = "xlsm") Then

      'Trigger jump to next attachment if file is passworded

      On Error GoTo TestExcelErr

      'set up temporary folder
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set strFolder = objFSO.GetSpecialFolder(2)
      strFileName = objAtt

      'save attachment to temporary folder
      objAtt.SaveAsFile strFolder & "\" & strFileName
      Set xlApp = CreateObject("Excel.Application")
      Set xlBook = xlApp.Workbooks.Open(strFolder & "\" & strFileName, , True, , "")

      'close attached file
      xlBook.Close False
      xlApp.Quit

      'notify user of unprotected file and prompt decision on sending
      answer = MsgBox("Excel attachment " & (objAtt.DisplayName) & _
        " is not password protected.  Send anyway?", _
        vbYesNo + vbExclamation, "Unprotected Workbook!") 
      If answer = vbNo Then
        Cancel = True
        MsgBox ("File not sent")
        Exit Sub
      Else
      End If

    End If

    'identify Powerpoint files
    If LCase(Right(objAtt.FileName, 4)) = "pptx" Or _
      LCase(Right(objAtt.FileName, 3) = "ppt") Then

      'Trigger jump to next attachment if file is passworded

      'On Error GoTo TestPowerPointErr

      'set up temporary folder
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set strFolder = objFSO.GetSpecialFolder(2)
      strFileName = objAtt

      'save attachment to temporary folder
      objAtt.SaveAsFile strFolder & "\" & strFileName
      Set pptApp = CreateObject("PowerPoint.Application")
      Set pptpres = pptApp.Presentations.Open(strFolder & "\" & strFileName, False)

      pptpres.Close

      answer = MsgBox("PowerPoint attachment " & (objAtt.DisplayName) & _
       " is not password protected.  Send anyway?", _
       vbYesNo + vbExclamation, "Unprotected Presentation!")

      If answer = vbNo Then
        Cancel = True
        MsgBox ("File not sent")
        Exit Sub
      Else
      End If

    End If
    GoTo NextAtt

TestExcelErr:

    'Check for an error returned by the Open statement (password needed)
    If Err() = 1004 Then
      GoTo NextAtt
    End If

TestPowerPointErr:

    'Check for an error returned by the Open statement (password needed)
    If Err() = 1004 Then
      GoTo NextAtt
    End If

NextAtt:
  Next objAtt

End If

End Sub