Discussion :

[toftrem]

Bonjour la communauté

J'utilise tous les jours ce code, via un raccourci dans la barre d'outils, qui m'est fort pratique et je remercie encore la communauté pour l'aide apportée en son temps (vers 2017 à peu près):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
 Sub SendUsingAccount()
  Set oOlSel = ActiveExplorer.Selection
 Dim oAccount As Outlook.account
 Set oAccount = Application.Session.accounts("christophe@be-ingetech.fr")
If oAccount Is Nothing Then MsgBox "Compte non trouvé": Exit Sub
    For Each oOlItm In oOlSel
    If oOlItm.Class = olMail Then
      Set oOlFwd = oOlItm.Forward
      oOlFwd.Attachments.Add oOlItm, olEmbeddeditem
      oOlFwd.To = "maison@be-ingetech.fr"
      oOlFwd.SendUsingAccount oAccount
      oOlFwd.Recipients.ResolveAll
'    oOlFwd.Display ' pour afficher
      oOlFwd.Send
    End If
   Next oOlItm
 
End Sub

Je souhaite me servir de ce code avec l'utilisation de règles OUTLOOK (pour automatiser un peu en fonction de certains mots dans l'objet).

J'ai donc inséré ce code VBA dans le script TEST suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
 Sub TEST(Mail As Outlook.MailItem)
  Set oOlSel = ActiveExplorer.Selection
 Dim oAccount As Outlook.account
 Set oAccount = Application.Session.accounts("christophe@be-ingetech.fr")
If oAccount Is Nothing Then MsgBox "Compte non trouvé": Exit Sub
    For Each oOlItm In oOlSel
    If oOlItm.Class = olMail Then
      Set oOlFwd = oOlItm.Forward
      oOlFwd.Attachments.Add oOlItm, olEmbeddeditem
      oOlFwd.To = "maison@be-ingetech.fr"
      oOlFwd.SendUsingAccount oAccount
      oOlFwd.Recipients.ResolveAll
'    oOlFwd.Display ' pour afficher
      oOlFwd.Send
    End If
   Next oOlItm
 
End Sub

J'appelle donc ce script TEST lors du paramétrage de mes règles mais il fait n'importe quoi (genre il me transfère le mail précédent déjà lu ou bien ne me tranfère rien du tout)



J'ai essayé plein de choses pour résoudre mon problème mais rien n'y fait:
- créer un nouveau profil dans OUTLOOK dans lequel je n'ai mis que mes comptes pop (pas d'imap ou de comptes gmail etc..)
- réparer mon fichier de données outlook
- tester un autre code en enlevant la condition objet pour l'appliquer à tous les messages entrants du compte en question:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub Arrive_NewMail(Mail As Outlook.MailItem)
MsgBox "Arrivée du message :" & vbCr & Mail.Subject & vbCr & " de:" & Mail.SenderName
End Sub

Et là ça fonctionne parfaitement avec ce script (qui m'affiche une fenêtre lors de la réception d'un message)

J'en déduis que c'est l'adaptation du code en script qui lui plait pas!

Qu en pensez vous?

[toftrem]

Bonjour à tous
Je déterre ce post car je n'ai pas eu de réponses et je n'arrive toujours pas a comprendre ce qui ne va pas...

une ame charitable peut elle m'aider svp?

Merci

Je résume vite fait mon post précedent:
j'ai une vba qui me donne entière satisfaction : SendUsingAccount()

Je souhaite automatiser son utilisation avec les règles outlook (en fonction de mots spécifiques dans l'objet)

Donc à la réception d'un mail --> si le mot est dans l'objet -->transfert du message (+copie du message en PJ) au destinataire défini dans la macro et en utilisant un compte précis dans mes nombreux comptes...

Merci pour votre précieuse aide!

Christophe

[toftrem]

Bonjour à tous
je déterre ce sujet car en bidouillant j'ai trouvé une solution et celle ci peut servir à d'autres.....:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 Sub SendUsingAccountF(oOlItm As Outlook.MailItem)
  Set oOlSel = ActiveExplorer.Selection
 Dim oAccount As Outlook.Account
 Set oAccount = Application.Session.Accounts("christophe@be-ingetech.fr")
If oAccount Is Nothing Then MsgBox "Compte non trouvé": Exit Sub
 '   For Each oOlItm In oOlSel
 '   If oOlItm.Class = olMail Then
      Set oOlFwd = oOlItm.Forward
      oOlFwd.Attachments.Add oOlItm, olEmbeddeditem
      oOlFwd.To = "maison@be-ingetech.fr"
      oOlFwd.SendUsingAccount oAccount
      oOlFwd.Recipients.ResolveAll
'    oOlFwd.Display ' pour afficher
      oOlFwd.Send
 '   End If
 '  Next oOlItm
 
End Sub

J'ai donc bidouillé la ligne 1 et commenté les lignes 6-7-15 et 16.

Donc au final la solution fonctionne avec les règles OUTLOOK....: quand un message arrive sur ce compte avec des mots clefs dans l'objet le transfert se fait automatiquement

Par contre j'ai un souci sur la signature de ce message transféré: la signature par défaut du compte sélectionné Application.Session.Accounts("christophe@be-ingetech.fr") ne s'affiche pas: il me met toujours la signature du compte sur lequel le message est arrivé!

Est il possible de rajouter une ligne qui forcerait une signature vide par exemple? ou carrément sans signature?

Merci pour votre aide

[toftrem]

Bonjour
Help svp....

Je cherche juste à choisir une signature enregistrée dans mon OUTLOOK pour ma routine

[toftrem]

Salut à tous (enfin à ceux qui se connectent encore à cette partie du forum...)

J'ai passé quelques heures pour enfin arriver à mes fins
J'ai réussi !

Bon ce code n'est pas parfait mais il fait le taf (j'en ai profité pour améliorer ma routine de base pour mes transferts internes...)

J'ai crée une signature vide que je déclare dans le code.
Voici le code final (avec les explications):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
Sub SendUsingAccount()
  Set oOlSel = ActiveExplorer.Selection
  Dim oAccount As Outlook.Account
 
  ' Choix du compte d'expedition:
  Set oAccount = Application.Session.Accounts("admin@be-ingetech.fr") 'choix du compte à utiliser
  If oAccount Is Nothing Then MsgBox "Compte non trouvé": Exit Sub
 
' Bloc Choix signature:
Dim SignaturePath As String
Dim Signature As String
Dim FSO As Object
Dim SignatureFile As Object
' Chemin vers le dossier des signatures
SignaturePath = Environ("appdata") & "\Microsoft\Signatures\"
' Vérifier si le dossier des signatures existe
If Dir(SignaturePath, vbDirectory) <> vbNullString Then
' Nom du fichier de la signature (remplacez "vide" par le nom de votre signature)
SignaturePath = SignaturePath & "vide.htm"
' Vérifier si le fichier de la signature existe
If Dir(SignaturePath) <> vbNullString Then
' Lire le contenu du fichier de la signature
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SignatureFile = FSO.OpenTextFile(SignaturePath, 1)
Signature = SignatureFile.ReadAll
SignatureFile.Close
Else
MsgBox "Le fichier de la signature n'a pas été trouvé.", vbExclamation
Exit Sub
End If
Else
MsgBox "Le dossier des signatures n'a pas été trouvé.", vbExclamation
Exit Sub
End If
' Fin Bloc Choix signature
 
' Bloc extraction données du mail selectionné:
Dim SelectedMail As MailItem
 Dim contenu As String
 Select Case TypeName(ActiveWindow)
    Case "Explorer"
        Set SelectedMail = ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set SelectedMail = ActiveInspector.CurrentItem
End Select
With SelectedMail
Nom_Prenom = .SenderName
date_reception = CDate(Int(.ReceivedTime))
heure_reception = TimeValue(.ReceivedTime)
destinataires = .To
CC = .CC
objet = .Subject
' .HTMLBody pour conserver la mise en forme du message d'origine
contenu = .HTMLBody
End With
 
' Bloc transfert du mail avec incorporation des PJ et du mail lui même en PJ:
    For Each oOlItm In oOlSel
    If oOlItm.Class = olMail Then
      Set oOlFwd = oOlItm.Forward
      oOlFwd.Attachments.Add oOlItm, olEmbeddeditem
      ' Choix du  destinataire:
      oOlFwd.To = "admin@be-ingetech.fr" 'mail destinataire
      oOlFwd.SendUsingAccount oAccount
      oOlFwd.Recipients.ResolveAll
      oOlFwd.HTMLBody = "" & Signature _
                                      & " <span style= ""color:#ff0000""> Expéditeur: </span> " & Nom_Prenom _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Destinataires: </span> " & destinataires & "; " & CC _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Date réception: </span> " & date_reception _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Heure réception: </span> " & heure_reception _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Objet: </span> " & objet _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Message: </span> <br><br> " & contenu
      oOlFwd.Display
      oOlFwd.Send
    End If
   Next oOlItm
End Sub

et sa version adaptée pour intégrer le code à un script pour l'exécution automatique via les règles outlook:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
Sub SendUsingAccountP(oOlItm As Outlook.MailItem)
  Set oOlSel = ActiveExplorer.Selection
  Dim oAccount As Outlook.Account
 
  ' Choix du compte d'expedition:
  Set oAccount = Application.Session.Accounts("admin@be-ingetech.fr") 'choix du compte à utiliser
  If oAccount Is Nothing Then MsgBox "Compte non trouvé": Exit Sub
 
' Bloc Choix signature:
Dim SignaturePath As String
Dim Signature As String
Dim FSO As Object
Dim SignatureFile As Object
' Chemin vers le dossier des signatures
SignaturePath = Environ("appdata") & "\Microsoft\Signatures\"
' Vérifier si le dossier des signatures existe
If Dir(SignaturePath, vbDirectory) <> vbNullString Then
' Nom du fichier de la signature (remplacez "vide" par le nom de votre signature)
SignaturePath = SignaturePath & "vide.htm"
' Vérifier si le fichier de la signature existe
If Dir(SignaturePath) <> vbNullString Then
' Lire le contenu du fichier de la signature
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SignatureFile = FSO.OpenTextFile(SignaturePath, 1)
Signature = SignatureFile.ReadAll
SignatureFile.Close
Else
MsgBox "Le fichier de la signature n'a pas été trouvé.", vbExclamation
Exit Sub
End If
Else
MsgBox "Le dossier des signatures n'a pas été trouvé.", vbExclamation
Exit Sub
End If
' Fin Bloc Choix signature
 
' Bloc extraction données du mail selectionné:
Dim SelectedMail As MailItem
 Dim contenu As String
' Select Case TypeName(ActiveWindow)
'    Case "Explorer"
'        Set SelectedMail = ActiveExplorer.Selection.Item(1)
 '   Case "Inspector"
       Set SelectedMail = oOlItm
'End Select
With SelectedMail
Nom_Prenom = .SenderName
date_reception = CDate(Int(.ReceivedTime))
heure_reception = TimeValue(.ReceivedTime)
destinataires = .To
CC = .CC
objet = .Subject
' .HTMLBody pour conserver la mise en forme du message d'origine
contenu = .HTMLBody
End With
 
' Bloc transfert du mail avec incorporation des PJ et du mail lui même en PJ:
  '  For Each oOlItm In oOlSel
  '  If oOlItm.Class = olMail Then
      Set oOlFwd = oOlItm.Forward
      oOlFwd.Attachments.Add oOlItm, olEmbeddeditem
      ' Choix du  destinataire:
      oOlFwd.To = "admin@be-ingetech.fr" 'mail destinataire
      oOlFwd.SendUsingAccount oAccount
      oOlFwd.Recipients.ResolveAll
      oOlFwd.HTMLBody = "" & Signature _
                                      & " <span style= ""color:#ff0000""> Expéditeur: </span> " & Nom_Prenom _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Destinataires: </span> " & destinataires & "; " & CC _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Date réception: </span> " & date_reception _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Heure réception: </span> " & heure_reception _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Objet: </span> " & objet _
                                      & "<br><br> " _
                                      & " <span style= ""color:#ff0000""> Message: </span> <br><br> " & contenu
      oOlFwd.Display
      oOlFwd.Send
 '   End If
 '  Next oOlItm
End Sub

[Nain porte koi]

Merci pour le retour, ça peut servir à d'autres