 | Navigation |  |
 | Login |  |
 | Connexions |  |
 | Bienvenue à [FAMACLUB] le 1,414ème membre Visiteurs en ligne : 4 Membres en ligne : 0
Non activés :0
Nombre de visiteurs depuis le : 12/11/2008
Aujourd'hui: | 366 | En ligne : | 4 | Max. en ligne: | 312 | Max. / jour: | 66 529 | Total hier: | 4 083 | Total ce mois: | 105 446 | Total visites: | 21 198 617 | Moyenne/jour: | 5 651 |
Dernières 24h
|  |  |  |  |
|
 | Publicité ; elle permet de financer le site |  |
 | Navigation parmi les catégories/articles |  |
 | R15350 [VBA] Choix du compte selon les destinataires |  |
 | Permet de choisir entre différents COMPTES selon les destinataires. Correspond au menu "Comptes" à coté de "Envoyer"
Function Set_Account(ByVal AccountName As String, M As Outlook.MailItem) As String 'Créée par Sue Mosher http://www.outlookcode.com/codedetail.aspx?id=889 '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
|  |  |  |  |
 | Commentaires |  |
 |
#1 |
le lundi 18 février 2008 18:54
|
#2 |
le mercredi 18 août 2010 12:11
|
|  |  |  |  |
 | Copyright et partage |  |
 | Articles similaires |  |
 | Nuage de tags |  |
 | R99480 Attention virus dangereux, R14040 Personnaliser la barre d'outils d'Outlook, R02060 Vérifier l'accès au serveur SMTP, R16050 Importer d'un autre PC les courriels d'Outlook Express vers Outlook sous Vista, R03010 Créer un nouveau message à partir d'un autre, R12055 Planifier une réunion, R08140 Interface non enregistrée ou interface non prise en charge, R07120 Interdire l'accès au paramétrage des comptes de messagerie et de carnet d'adresses, R16050 Importer d'un autre PC les courriels d'Outlook Express vers Outlook sous Vista, R09005 Différence entre « Carnet d'adresses » et « Contacts », R08060 Recréer un profil, R00020 Mettre Outlook 2002 (et autres) dans le systray, R04010 Insérer une image dans un message, R15220 [VBA] Supprimer les Pièces jointes., R15210 [VBA] Déplacer le contenu d'un dossier vers un pst. |  |  |  |  |
aucun Crack, CrackZ, no-CD, DownloadZ, TelechargementZ, Serial, Numéro de série, N0 de série, Serialz ni Keygen pour Outlook sur ce site.
|  | Blague aléatoire |  |
 | Publicité |  |
 | Météo Marseille |  |
|
J'ai trouvé très interessant cette macro, je l'ai testé mais j'ai une erreur sur CBP.Reset Erreur d'execution 91 Variable objet ou variable de bloc With non définie ???
Pouvez vous m'aider Merci