Choisir une macro en fonction de la messagerie présente sur le PC, Lotus Notes ou Outlook

**goninph** · 25/03/2016, 11h36

Bonjour,

Comment choisir une macro en fonction de la messagerie présente sur le PC, Lotus Notes ou Outlook
Sachant que chaque PC à soit LOTUSNOTES, soit OUTLOOK

J'ai 2 macros :
Mail_LOTUS qui génére un mail compatible avec LOTUSNOTES
Mail_OUTLOOK qui génére un mail compatible avec OUTLOOK

Comment écrire le code de la macro EnvoiMail ?

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub EnvoiMail()
 
Trouver quelle type de messagerie est présente : Lotus Notes ou Outlook
Si LOTUS 
Lancer la macro Mail_LOTUS 
 
Si OUTLOOK 
Lancer la macro Mail_OUTLOOK 
 
End Sub

Merci pour votre aide

Philippe

**kiki29** · 25/03/2016, 12h25

Salut, voir ici

**cerede2000** · 25/03/2016, 13h40

@kiki29 : Ce n'est pas vraiment la réponse qu'il attends.
Il cherche à déterminer quel est le client de messagerie utilisé sur le PC en premier lieu.

@goninph : Regarde dans cette clé registre :

Code :

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

HKCR\mailto\shell\open\command

Si elle contient Outlook.exe alors c'est Outlook, je n'ai pas de Lotus sous la main, mais il faut que tu regardes sur un PC qui possède Lotus la valeur présente

Regarde aussi la clé :

Code :

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

HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail\

Dans la valeur par défaut

**goninph** · 25/03/2016, 13h43

Hello,

Merci, mais j'ai changer de technique, car on risque d'avoir les 2 messagerie en même temps

Alors j'ai créé une celleule de sélection, la Q10 ou 2 sélections sont possibles OUTLOOK ou LOTUS NOTES

Voici ma macro, mais j'ai une erreur :

Erreur de compilation : Variable ou procédure, et non un module ......

Help Merci

Code :

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

1
2
3
4
5
6
7
8
Sub EnvoiMail()
 
 If Sheets("Journal du projet").Range("Q10") = "OUTLOOK" Then Run Mail_OUTLOOK 'Macro qui génère le mail pour OUTLOOK
 If Sheets("Journal du projet").Range("Q10") = "LOTUS NOTES" Then Run Mail_LOTUS_NOTES 'Macro qui génère le mail pour LOTUS NOTES
 
 End If
 
End Sub

**cerede2000** · 25/03/2016, 13h47

Change tes Run en Call et pense à utiliser les balises CODE pour mettre du code sur le forum.
Bouton #

**goninph** · 25/03/2016, 13h52

Merci, déjà essayé, mais excatement la même erreur, pas facile .....

**marccelestins** · 25/03/2016, 13h57

Bonjour,

Si j'ai bien compris tu envoies un mail et tu souhaites que la macro outlook se declenche si la personne a outlook et lotus si la personne a lotus. Il suffit de lancer l'envoi de mail avec lotus et s'il ne trouve pas lotus dans l'erreur j'appel l'envoi de mail 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
Sub Mailoutlook(ByVal MailDestinataire As String, ByVal MailCC As String, ByVal Sujet As String, ByVal CorpsMessage As String, _
ByVal FichierJoint As String, Optional ByVal FichierJoint2 As String, Optional ByVal FichierJoint3 As String)
 
OnErrorGoToGerreur
 
DimolAsNewOutlook.Application
DimolmailAsMailItem
 
'envoie d'un e-mail
Set ol = NewOutlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = MailDestinataire
      .CC = MailCC
.Subject = Sujet
.Body = CorpsMessage
 
If FichierJoint <> "" Then
.Attachments.Add FichierJoint
End If
If FichierJoint2 <> "" Then
.Attachments.Add FichierJoint2
End If
If FichierJoint3 <> "" Then
.Attachments.Add FichierJoint3
End If
 
.Display
 
 
.Send
 
End With
end sub

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
Sub Maillotus(ByVal MailDestinataire As String, ByVal MailCC As String, ByVal Sujet As String, ByVal CorpsMessage As String, _
                ByVal FichierJoint As String, Optional ByVal FichierJoint2 As String, Optional ByVal FichierJoint3 As String)
 
On Error GoTo Gerreur
 
'Dim session As Domino.NotesSession
Dim session As Object
Dim db As Object
Dim doc As Object
Dim attachme As Object
Dim EmbedObj As Object
Dim attachment As String
Dim I As Integer
 
Set session = CreateObject("notes.notessession")
Set db = session.GETDATABASE("", "")
Call db.openmail
 
Set doc = db.createdocument
 
With doc
    .Form = "Memo"
    .sendto = MailDestinataire
    .Subject = Sujet
    .Body = CorpsMessage
    .From = session.COMMONUSERNAME
    .CopyTo = MailCC
    .posteddate = Now
    .SaveMessageOnSend = True
End With
 
If FichierJoint <> "" Then
    Set attachme = doc.CreateRichTextItem("Attachment")
    Set EmbedObj = attachme.embedObject(1454, "", FichierJoint, "Attachment")
End If
 
If FichierJoint2 <> "" Then
        Set EmbedObj = attachme.embedObject(1454, "", FichierJoint2, "Attachment")
End If
If FichierJoint3 <> "" Then
        Set EmbedObj = attachme.embedObject(1454, "", FichierJoint3, "Attachment")
End If
 
 Call doc.Send(False)
 
Exit Sub
Gerreur:
Call MailOutlook(MailDestinataire, MailCC, Sujet, CorpsMessage, FichierJoint, FichierJoint2, FichierJoint3)
 
'MsgBox Err.Number & " : " & Err.Description, vbCritical, "Erreur"
end sub

**goninph** · 25/03/2016, 15h09

Parfait et merci, mais c'était ma première idée.

En cherchant sur les forum, voici ma nouvelle idée : C'est de pouvoir envoyer un mail en selectionant la messagerie, car nous allons avoir les messagerie sur le même PC ....

Sur la feuille "journal du Projet" la cellule Q10 que j'ai renommé "Type_Messagerie" à 2 choix possibles "OUTLOOK" et "LOTUS NOTES"

Si lorsque je clique sur les bontons envoyer un mail, la cellule Q10 contient le texte "OUTLOOK", le mail sera généré par la macro "Mail_OUTLOOK" et si Q10 contient le texte "LOTUS NOTES", le mail sera généré par la macro "Mail_LOTUS_NOTES"

Si par erreur la messagerie selectionnée n'existe pas sur le PC, une messagebox doit s'ouvrir en indiquant à l'utilisateur de selectionner la bonne messagerie

Toutes les macro sont dans des modules et il y a un bouton "Envoyer mail" sur plusieurs feuilles

En espérant être compris, je vous remercie pour votre aide

Philippe

Choisir sa messagerie.xlsm

Voilà le fichier vite fait, car le principal est trop lourd

**cerede2000** · 25/03/2016, 15h14

Ahhhhhh !!!!!!!

En effet avec le fichier on comprends mieux ton problème

Tu appel tes modules et tes Sub exactement pareilles, du coup lorsque tu appel juste MailOutlook VBA ne sait pas si c'est le module ou la Sub que tu veux...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub EnvoiMail()
 
With Sheets("Journal du projet")
If .Range("Q10") = "OUTLOOK" Then
 MailOutlook.MailOutlook
ElseIf .Range("Q10") = "LOTUS NOTES" Then
MailLotus.MailLotus
 End If
End With
 
End Sub

Ceci fonctionnera nettement mieux

Mais autant créé une fonction qui s’appelle pareille dans les deux modules (si tu veux vraiment séparer).
Genre Mail et appeler en fonction
MailOutlook.Mail ou MailLotus.Mail

**goninph** · 25/03/2016, 15h31

NICKEL Merci Mille Merci c'est tout bon

Trop fort

**cerede2000** · 25/03/2016, 15h33

Pour la verif de messagerie je te conseil tout de même de jeter un oeil aux clés registres que j'ai indiqué plus haut

**Oliv-** · 29/03/2016, 10h05

Bonjour,

J'avais ce code lorsque l'on avait encore Lotus

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
    ClientMessagerie = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail", "")
 
    If ClientMessagerie = "Microsoft Outlook") Then
 
        '####### ENVOI PAR OUTLOOK #######################
 
 
    ElseIf  ClientMessagerie = "Lotus Notes") Then
 
        '####### ENVOI PAR OUTLOOK #######################
 
    Else    'sinon envoi par méthode mailto:
 
        EnvoiEmail_sur_DEFAULT FormChoix.TextBoxEmail, Sujet, Corps, source_name, "", "", 0
 
    End If

A mettre dans un Module

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
'Dans le module :
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
 
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1    ' Unicode nul terminated String
Public Const REG_DWORD = 4    ' 32-bit number
Public Sub savekey(Hkey As Long, strPath As String)
    Dim keyhand&
    r = RegCreateKey(Hkey, strPath, keyhand&)
    r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
'EXAMPLE:
'
'text1.text = getstring(HKEY_CURRENT_USE
'     R, "Software\VBW\Registry", "String")
'
    Dim keyhand As Long
    'Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    r = RegOpenKey(Hkey, strPath, keyhand)
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
 
 
    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
 
 
        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))
 
 
            If intZeroPos > 0 Then
                getstring = Left$(strBuf, intZeroPos - 1)
            Else
                getstring = strBuf
            End If
        End If
    End If
End Function

Choisir une macro en fonction de la messagerie présente sur le PC, Lotus Notes ou Outlook [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager