vba - 识别 MS Excel 或 MS Access 附件并警告检查内容

Question

个人识别信息 (PII) 通常是通过非加密电子邮件无意中传输的。大多数情况下，这些数据存储在 Excel 或 Access 电子表格中。

我想在点击发送后识别 Access 或 Excel 附件并询问“此电子邮件附加了 Access 或 Excel 文件，您确定这些不包含 PII 吗？”

在附件名称中识别“xlsx”或“accdb”的标准我只是不明白。

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

If Right([attachment_Name],4) = xlsx then

    answer = MsgBox("There are Access or Excel files attached to this email, are you sure these do not contain PHI?",vbYesNo)

    If answer = vbNo 
        Cancel = True
    Else

    End If

End If

End Sub

Answer 1

这是您要查找的代码：

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

Dim bolSensitiveAttach As Boolean
Dim answer As Double

Set Msg = Item

bolSensitiveAttach = False
If Msg.Attachments.Count > 0 Then
    For i = 1 To Msg.Attachments.Count
         If Right(Msg.Attachments(i).FileName, 3) = "xls" Or  _
                Left(Right(Msg.Attachments(i).FileName, 4), 3) = "xls" Or _
                Right(Msg.Attachments(i).FileName, 5) = "accdb" Or _
                Right(Msg.Attachments(i).FileName, 3) = "mdb" Then  
                     bolSensitiveAttach = True
         End If

    Next i
End If

If bolSensitiveAttach = True Then
    answer = MsgBox("There are Access or Excel files attached to this" _
                 & "mail, are you sure these do not contain PHI?", vbYesNo)
    If answer = vbNo Then
        Cancel = True
    End If
End If

End Sub

希望这可以帮助。

编辑后包含 .mdb 扩展名和 xls* 扩展名（xlsm、xlsx...），而不仅仅是 xlsx。谢谢你的建议冻糕。

Answer 2

您可以使用FileSystemObject来获取扩展名：

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

    Dim olAtt As Attachment
    Dim oFSO As Object
    Dim sExt As String
    Dim bSafe As Boolean

    If Item.Attachments.Count > 0 Then
        bSafe = True
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        For Each olAtt In Item.Attachments
            sExt = oFSO.GetExtensionName(olAtt.FileName)
            If sExt Like "xls*" Or sExt Like "accd*" Or sExt = "mdb" Then
                bSafe = False
                Exit For
            End If
        Next olAtt

        If Not bSafe Then
            If MsgBox("This email contains an Access or Excel file." & vbCr & _
                      "Do you wish to continue?", vbCritical + vbYesNo) = vbNo Then
                Cancel = True
            End If
        End If

        Set oFSO = Nothing

    End If
End Sub  

我已将 Access 包含在内，但很确定默认情况下不会发送。