通过 VBA 宏验证 Outlook 电子邮件附件名称

Question

我正在创建一个 Outlook 宏以在发送邮件之前验证电子邮件附件和收件人姓名。

可以通过 Outlook 会话中的 ItemSend 功能轻松验证收件人姓名。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)   
Dim Recipients As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim i
Dim prompt As String

Set Recipients = Item.Recipients
For i = Recipients.Count To 1 Step -1
Set recip = Recipients.Item(i)

If InStr(LCase(recip), "bad@address.com") Then
  prompt$ = "You sending this to this to " & Item.To & ". Are you sure you want to send it?"
   If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
     Cancel = True
   End If
End If

Next i  
End Sub

虽然这有助于收件人，但它不允许在发送邮件之前验证附件名称。即验证邮件草稿。下面的代码有助于检查草稿中的附件，但无助于验证。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If InStr(1, Item.Body, "attach", vbTextCompare) > 0 Then
If Item.Attachments.Count = 0 Then
    answer = MsgBox("There's no attachment, send anyway?", vbYesNo)
If answer = vbNo Then Cancel = True
End If

所以我尝试添加 item.Attachment。名称 \ item.attachment.FileName 但这仅在我将其归因于 Outlook MailItem 而不是普通对象时才有效。

是否可以创建代码来验证特定标准的附件名称（名称应符合特定命名约束）。代码已经创建并作为普通宏而不是会话宏。

Function Segregate_Function(Attach_Name_Pass1 As String)

Dim FullName As String
Dim Recepients As String

Region_Ext = Right(Attach_Name_Pass1, 7)
region = Left(Region_Ext, 3)
'MsgBox region

If region = "ENG" Then
Recepients = "ABC@gmail.com;XYZ@gmail.com"
Call Send_Function(Attach_Name_Pass1, Recepients)
Else
MsgBox " Not an Acceptable Attachment. Mail Could not be Generated "
End If
End Function

我希望在单击发送以直接验证附件名称时执行上述代码，而不是运行程序宏。

做建议。

Answer 1

尝试在 ItemSend 中进行测试。

类似这样的：

Option Explicit

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

Dim att As attachment
Dim Attach_Name_Pass1 As String
Dim Region_Ext As String
Dim Region  As String

Cancel = False

If Item.Attachments.count = 0 Then
    If MsgBox("There's no attachment, send anyway?", vbYesNo) = vbNo Then Cancel = True

Else
    Debug.Print Item.To
    If InStr(Item.To, "ABC@gmail.com") > 0 Or InStr(Item.To, "XYZ@gmail.com") > 0 Then

        For Each att In Item.Attachments
            Attach_Name_Pass1 = att.DisplayName
            Region_Ext = Right(Attach_Name_Pass1, 7)
            Region = Left(Region_Ext, 3)
            'MsgBox region
            Debug.Print Region

            If Region <> "ENG" Then
                Cancel = True
                MsgBox " Not an Acceptable Attachment. Send cancelled."
                Exit For
            End If
        Next
    End If

End If

End Sub