Você precisa disso; se nenhuma categoria for definida, a operação de envio será cancelada:
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean) Dim oc As OlObjectClass oc = item.Class If oc = olMail Or oc = olReport Or oc = olMeetingRequest Then item.ShowCategoriesDialog item.BillingInformation = item.Categories If item.Categories = "" Then Cancel = True End If End Sub
O BillingInformation também está definido, pois é transmitido de volta inalterado quando os destinatários respondem, portanto as respostas recebidas já estão categorizadas corretamente ... para que isso funcione, você também precisará disso:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) Dim arr() As String, i As Integer Dim ns As Outlook.NameSpace Dim itm, m As MailItem On Error Resume Next Set ns = Application.Session arr = Split(EntryIDCollection, ",") For i = 0 To UBound(arr) Set itm = ns.GetItemFromID(arr(i)) If itm.Class = olMail Then Set m = itm If m.Categories = "" And m.BillingInformation "" Then m.Categories = m.BillingInformation m.BillingInformation = "" m.Save End If End If Next End Sub
Atenciosamente MF