selection automatique d'un compte

[ManeBlon]

Bonjour à tous

J'ai 2 compte de messagerie, l'un perso ( defini par défaut) et l'autre nommé fax qui me permet d'envoyez des fax ou des sms.
J'aimerai suivant l'adresse mail de mon destinataire changer mon compte d'envoi par défaut par celui du Fax.
Quelqu'un pourrait'il me dire quel est l'objet qui regroupe dans Outlook les differents comptes de messagerie existants. Une fois que j'aurais celui-ci je ferai une macro faisant un test sur l'adresse du destinataire et suivant celle-ci ( les adresse de fax ou de sms n'ont que des N° avant l'@) je prendrai l'adresse du Fax.
Merci d'avance

[Oliv-]

Salut,

Code :

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

Oliv'

[Vbapprentis]

Bonsoir,

j'ai regardé ton oliv et j'aurais aime choisir le compte à utliser par l'intemediaire de mon userform.J'arrive pas à adapter le code.

Aurais tu une idée
j'ai 2 comptes

merci

[Oliv-]

Salut,
Oui mais si tu ne décris pas celui-ci je ne sais aps vraiment t'aider.
Si tu as 2 boutons sur onclick tu affectes Set_Account("pop.compte1.fr", oitem) et sur l'autre Set_Account("pop.compte2.fr", oitem) .

Oliv'

[Vbapprentis]

Bonsoir,

j'ai rajouté çà dans mon userform, comme tu me proposais il me mets en rouge la macro

Code :

1
2
3
Private Sub OptionButton1_Click()
Set_Account("compte@test.fr", oitem)
End Sub

Faut il que je rajoute dans un module la macro de l'autre site?

[ManeBlon]

Bonjour

Oliv, j'ai récupéré et installé la macro. J'ai appris pas mal de choses même si tout n'est pas encore trés clair.
J'ai tout de même un petit soucis : le message une fois passé par la macro et le compte modifié s'il y a lieu est envoyé; lorsque je le récupére dans boite des messages envoyés l'adresse par défaut a été remise, la modification par macro n' a pas été conservée. Et j'ai bien vérifié ! Pourquoi ?

Je suis vraiment dans le noir, Eclairez moi !
Merci d'avance,

Mane

[Oliv-]

Salut,
Oui tu dois ajouter la fonction Set_Account
et oitem dans mon exemple est la variable object qui désigne ton mail.
Il faudrait que tu expliques le rôle de ton userform agit'il sur un mail déjà créé ou va t'il lancer la création de celui-ci ?

Oliv'

[Vbapprentis]

Bonjour,

oliv, si tu a 1 peu de temps j'ai mis dans 1 autre post ce que je souhaite faire.

j'ai résolu une partie, mais pas toutn notamment ecrire le nom de expediteur et jongler comme sur ce post entre 2 comptes