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。 Name \ 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

我希望上面的代码在单击send直接验证附件名时执行，而不是运行过程宏。

做建议。

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

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

1 个答案: