1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Function Set_Account(ByVal AccountName As String, M As Outlook.MailItem) As String
'Créée par Sue Mosher
'et modifiée par Oliv' pour OUTLOOK 2003
Dim OLI As Outlook.Inspector Dim strAccountBtnName As String
Dim intLoc As Integer
Const ID_ACCOUNTS = 31224
Dim CBs As Office.CommandBars Dim CBP As Office.CommandBarPopup
Dim MC As Office.CommandBarControl
Set OLI = M.GetInspector If Not OLI Is Nothing Then
Set CBs = OLI.CommandBars
Set CBP = CBs.FindControl(, ID_ACCOUNTS) CBP.Reset
If Not CBP Is Nothing Then
For Each MC In CBP.Controls intLoc = InStr(MC.Caption, " ")
If intLoc > 0 Then
strAccountBtnName = Mid(MC.Caption, intLoc + 1)
Else
strAccountBtnName = MC.Caption
End If
If strAccountBtnName = AccountName Then
MC.Execute
Set_Account = AccountName GoTo Exit_Function
End If
Next
End If
End If
Set_Account = ""
Exit_Function: Set MC = Nothing
Set CBP = Nothing
Set CBs = Nothing
Set OLI = Nothing End Function
' SOIT en execution manuelle ou dans une macro
Private Sub test_account_easy()
Dim oitem As Outlook.MailItem
Set oitem = ActiveInspector.CurrentItem MsgBox oitem.Recipients.Count & " destinataires"
Dim toto 'Ici on boucle sur tous les destinataires à la recherche de la concordance.
For Each toto In oitem.Recipients If toto.Address Like "*mon@destinataire.fr*" Or toto.Address _
Like "*@destinataire.fr*" Then
ici = True
MsgBox toto.Address
Else: ici = False
' on quitte la boucle si un seul ne concorde pas
Exit For
End If
Next toto If Not ici = True Then
go = Set_Account("pop.easynet.fr", oitem) Else
go = Set_Account("Serveur Microsoft Exchange", oitem) End If
End Sub
'Soit en Automatique à l'envoi
Private Sub Application_ItemSend(ByVal Item AS Object, Cancel As Boolean)
Dim toto 'Ici on boucle sur tous les destinataires à la recherche de la concordance.
For Each toto In Item.Recipients 'Si un destinataire correspond on quitte la boucle et applique le compte
If toto.Address Like "*mon@destinataire.fr*" Then
ici = True Exit for
Else: ici = False
End If
Next toto If Not ici = True Then
go = Set_Account("pop.easynet.fr", Item) Else
go = Set_Account("Serveur Microsoft Exchange", Item) End If
End Sub |
Partager