Discussion :

[JeanPaulR]

Bonjour,

Je suis vraiment très très débutant en VBA et complètement perdu.
J'ai trouvé le code ci-dessous qui marche bien mais que je n'arrive pas à le lancer avec la macro "exécutercode". Il faudrait passer par une "function" que je ne sais pas écrire.
Merci de m'aider en m'indiquant ce que je dois faire.
D'avance merci bcp.

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
Public Sub SendOLMail2( _
ByVal strEmail As String, _
ByVal strObj As String, _
ByVal strMsg As String, _
ByVal blnEdit As Boolean, _
Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
On Error GoTo OLMailErr
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
.To = strEmail
.Subject = strObj
.Body = strMsg
For Each varPJ In avarFichiers
.Attachments.Add (varPJ)
Next 
If blnEdit Then
.Display
Else
.Send
End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Sub
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
Sub TestSendOLMail2()
Dim astrFichiers(1 To 1) As String
astrFichiers(1) = "K:\Testmacro.xlsx"
SendOLMail2 "email@fournisseur.com", _
"Quelques pièces jointes...", _
"Salut," & vbCrLf & "Ci-joint, quelques fichiers pour tester..." _
& vbCrLf & "-- Hervé Inisan.", _
True, _
astrFichiers
End Sub

[LedZeppII]

Bonjour,

L'action de macro ExécuterCode ne voit que les fonctions (Function) et pas les procédures (Sub).
Ces fonctions doivent être dans un module de code et pas dans un module de classe, ni dans le module de code d'un formulaire.

Dans ton code, il suffit de transformer les procédures en fonctions.
Procédure:

Code :

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

1
2
3
Sub Nom()
...
End Sub

Fonction:

Code :

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

1
2
3
Function Nom()
...
End Function

Il faut aussi remplacer les Exit Sub par Exit Function.

A+

[JeanPaulR]

Bonjour,
Tout d'abord merci d'avoir pris mon problème en charge et de m'aider.
J'éprouve toujours des difficultés. En effet, en créant la macro Executercode, je trouve bien dans le générateur d'expression son nom, les arguments proposés sont : SendOLMail(«strEmail»; «strObj»; «strMsg»; «blnEdit»; «avarFichiers»). Au lancement elle m'indique : "L'objet ne contient pas d'objet automation "strmail" ... pour définir une propriété et une méthode....
Je ne comprends pas !

D'autre part, j'ai repris mon code en tenant compte de vos observations. Je vous le soumet ci-dessous avec 2 novations qui correspondent à mon besoin.
1/L'adresse du destinataire égal au nom qui s'affiche dans la case Email de mon formulaire (ce code est-il bon ?).
2/ Une condition en fonction d'un paramètre du nom qui s'affiche dans la case franchiseur de mon formulaire (ce code aussi est-il bon ?).
Je vous remercie encore beaucoup de l'assistance que vous m'apportez.
Bon après midi.

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
Option Compare Database
 
Function SendOLMail2( _
ByVal strEmail As String, _
ByVal strObj As String, _
ByVal strMsg As String, _
ByVal blnEdit As Boolean, _
Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
On Error GoTo OLMailErr
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
.To = strEmail
.Subject = strObj
.Body = strMsg
For Each varPJ In avarFichiers
.Attachments.Add (varPJ)
Next
If blnEdit Then
.Display
Else
.Send
End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Function
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Function
If Franchiseur = "" Then
'Condition d'envoi de mon message
Dim strDest As String
Dim strMessage As String
Dim astrFichiers(1 To 1) As String
strDest = "EMAIL:"
'C'est l'adresse Email affiché dans mon formulaire
strMessage = "Papa"
astrFichiers(1) = "K:"
SendOLMail2 strDest, strMessage, astrFichiers(1), True
Else
Franchiseur = ""
Dim strDest As String
Dim strMessage As String
Dim astrFichiers(1 To 1) As String
strDest = "EMAIL:"
'C'est l'adresse Email affiché dans mon formulaire
strMessage = "Papa"
astrFichiers(1) = "K:\Testmacro.xlsx"
SendOLMail2 strDest, strMessage, astrFichiers(1), True
End If
End Function

[LedZeppII]

Bonsoir,

Le code de la fonction doit ressembler à ceci :

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
Public Function SendOLMail2( _
                            ByVal strEmail As String, _
                            ByVal strObj As String, _
                            ByVal strMsg As String, _
                            ByVal blnEdit As Boolean, _
                            Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
 
On Error GoTo OLMailErr
 
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
    .To = strEmail
    .Subject = strObj
    .Body = strMsg
    For Each varPJ In avarFichiers
        .Attachments.Add (varPJ)
    Next 
    If blnEdit Then
       .Display
    Else
       .Send
    End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Function
 
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Function
End Function

Concernant son utilisation dans une macro :
«strEmail»; «strObj»; «strMsg»; «blnEdit»; «avarFichiers» sont les arguments de la fonction.
Il faut les fournir, mis à part le dernier qui est facultatif.
Je ne suis pas sûr, mais il me semble que l'assistant met des point-virgules par erreur.
Exemple avec des virgules :

Code Action:ExécuterCode, Nom de la fonction :

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

SendOLMail2("addr_mail@titi.fr", "Le titre du message", "Le message lui-même", True)

Si l'email doit être créé à partir d'un formulaire qui contient des données à inclure dans cet email,
il serait plus facile de créer une procédure événementielle, plutôt qu'une macro.
Pour créer une procédure événementielle, en face du nom de l'événement ("Sur Clic" par exemple), au lieu de choisir une macro
on choisit [Procédure événementielle] puis on clique sur le bouton [...]
On arrive dans une procédure vide.

Code :

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

1
2
3
Private Sub MonBouton_Click()
 
End Sub

Il n'a plus qu'à ajouter du code à l'intérieur de la procédure, c'est à dire entre les lignes Private Sub MonBouton_Click() et End Sub.

Exemple

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
Private Sub MonBouton_Click()
Dim sDestinataire As String
Dim sSujet As String
Dim sMessage As String
Dim astrFichiers(1 To 1) As String
 
sDestinataire = "email@fournisseur.com"
sSujet = "Quelques pièces jointes..."
sMessage = "Salut," & vbCrLf & "Ci-joint, quelques fichiers pour tester..."
astrFichiers(1) = "K:\Testmacro.xlsx"
 
' Appeler la fonction
SendOLMail2 sDestinataire, sSujet, sMessage, True, astrFichiers
 
End Sub

Si on veut récupérer des information sur le formulaire, on remplace

Code :

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

1
2
3
sDestinataire = "email@fournisseur.com"
sSujet = "Quelques pièces jointes..."
sMessage = "Salut," & vbCrLf & "Ci-joint, quelques fichiers pour tester..."

par

Code :

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

1
2
3
sDestinataire = Me.txtAddrEmail
sSujet = Me.txtSujet
sMessage = Me.txtMessage

où txtAddrEmail, txtSujet, txtMessage sont des contrôles zones de texte du formulaire.
txtAddrEmail, txtSujet, txtMessage sont les noms des contrôles.
Le nom d'un contrôle se trouve dans la feuille de propriétés, onglet «Autres».

A+

[JeanPaulR]

Bonsoir,

Merci bcp de votre réponse. Après avoir pas mal bataillé toute la journée, j'arrive grace à vous à faire marcher ce soir un petit qq chose. Vous pourrez vérfier par vous même dans le code ci-dessous. Si je peux me permettre d'abuser de votre gentillesse, j'aurai 3 questions subsidiaires à vous poser :

1/ Je n'arrive pas à trouver la syntaxe d'une condition (franchiseur ds mon cas)pour l'envoi de mon mess, c'est l'ABC, je sais ... mais je n'en suis même pas encore à ce stade là. Mais je travaille dur ....
2/ L'Email généré prend cette forme : XX@wanadoo.fr#mailto:XX@wanadoo.fr#bloquant le départ du mail. Vous savez pourquoi ?
3/ Dans le corps de mon message d'envoi, je souhaiterais intégrer l'image Jpeg du logo de mon entreprise. Cela est-il possible ?

En vous remerciant à nouveau,

Bonne soirée

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
 Public Sub SendOLMail( _
  ByVal strDest As String, _
  ByVal strObj As String, _
  ByVal strMsg As String, _
  ByVal blnEdit As Boolean, _
  Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
On Error GoTo OLMailErr
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
  .To = strDest
  .Subject = strObj
  .Body = strMsg

    .Attachments.Add "C:\Testmacro.xlsx"
 
  If blnEdit Then
    .Display
  Else
    .Send
  End If
End With
 
Set mi = Nothing
Set ol = Nothing
Exit Sub
 
OLMailErr:
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
    Exit Sub
 
End Sub
Private Sub Commande62_Click()
Dim astrFichiers(1 To 1) As String
astrFichiers(1) = "C:\Testmacro.xlsx"
If Me.[Franchiseur] = "XX" Then
'C'est la que je bloque : si Me.[Franchiseur] = "XX" est vrai, j'excécute l'envoi, si non je passe SendOLMail2 du suivant qui correspond, à un autre type de mess personnalisé, etc ...
SendOLMail Me.[EMAIL:], _
"Franchise xx", _
"Bonjour," & vbCrLf & "Je  suis le consultant mandaté  par xx  pour le recrutement de ses franchisés." _
& vbCrLf & "J'ai bien reçu votre demande d'information concernant cette franchise." _
& vbCrLf & "Vous trouverez en PJ la plaquette commerciale de cette enseigne." _
& vbCrLf & "A réception du Questionnaire que vous trouverez en  PJ, je vous contacterai par téléphone pour un premier entretien d'information." _
& vbCrLf & "A ce moment là, nous discuterons ensemble de vos possibilités pour réaliser ce projet." _
& vbCrLf & "Dans l'attente," _
& vbCrLf & "Cordialement." _
& vbCrLf & "xx", _
True, _
astrFichiers
End If
End Sub

[LedZeppII]

Bonjour,

1. Question syntaxe exécution conditionnelle.
Je ne suis pas certain d'avoir compris la question.
Si c'est pour créer un message différent selon le contenu de Me.[Franchiseur], il y a deux possibilité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
If Me.[Franchiseur] = "XX" Then
   ' je mets ici le code pour le cas XX
   ' ...
ElseIf Me.[Franchiseur] = "YY" Then
   ' je mets ici le code pour le cas YY
   ' ...
ElseIf Me.[Franchiseur] = "ZZ" Then
   ' je mets ici le code pour le cas ZZ
   ' ...
Else
   ' je mets ici le code pour "aucaun des cas précédents"
   ' c'est dire ni XX, ni YY, ni ZZ
   ' ...
End If

ou

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
Select Case Me.[Franchiseur]
    Case "XX"
   ' je mets ici le code pour le cas XX
   ' ...
    Case "YY"
   ' je mets ici le code pour le cas YY
   ' ...
    Case "ZZ"
   ' je mets ici le code pour le cas ZZ
   ' ...
    Case Else
   ' je mets ici le code pour "aucaun des cas précédents"
   ' c'est dire ni XX, ni YY, ni ZZ
   ' ...
End Select

2. Question syntaxe adresse email
XX@wanadoo.fr#mailto:XX@wanadoo.fr# est la syntaxe d'une adresse email stockée dans un champ de type lien hypertexte.
Ce n'est pas compatible avec ce que Outlook attend.
L'adresse email se trouve derrière "mailto:".
Voici une fonction pour extraire l'adresse email :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Function GetEmailfromMailto(sUrlMailto As String) As String
Dim posMailto As Long, sEmail As String
' Rechercher "mailto:" et ne garder que ce qui est à sa droite
posMailto = InStr(1, sUrlMailto, "mailto:", vbTextCompare)
If posMailto > 0 Then
   sEmail = Mid(sUrlMailto, posMailto + Len("mailto:"))
   ' Enlever le # se trouvant à la fin
   If Right(sEmail, 1) = "#" Then sEmail = Left(sEmail, Len(sEmail) - 1)
End If
' Retourner l'adresse email
GetEmailfromMailto = sEmail
End Function

Dans le code de la procédure événementielle Commande62_Click() j'utiliserai une variable pour l'adresse email.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Commande62_Click()
Dim astrFichiers(1 To 1) As String
Dim sDestinataire As String
 
sDestinataire = Me.[EMAIL:]
' Si c'est une url mailto, extraire l'adresse email
If InStr(1, sDestinataire, "mailto:", vbTextCompare)>0 Then
   sDestinataire = GetEmailfromMailto(sDestinataire)
End If
 
' ... suite du code ...
End Sub

Dans la suite du code, au lieu d'utiliser Me.[EMAIL:] on utilisera sDestinataire.

3. Question sur insertion image.
Je pense que c'est possible, mais je ne l'ai jamais fait.
Je ne sais pas si c'est simple ou compliqué à mettre en œuvre.

A+

[JeanPaulR]

Bonjour, et merci pour vos conseils. J'ai repris selon vos conseils mais je bloque toujours sur le code If, Elsef.

Regardez, si vous pouvez me débloquer. D'avance merci bcp et bonne soirée.

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
Public Sub SendOLMail( _
  ByVal strDest As String, _
  ByVal strObj As String, _
  ByVal strMsg As String, _
  ByVal blnEdit As Boolean, _
  Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
On Error GoTo OLMailErr
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
  .To = strDest
  .Subject = strObj
  .Body = strMsg
For Each varPJ In avarFichiers
.Attachments.Add (varPJ)
Next
  If blnEdit Then
    .Display
  Else
    .Send
  End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Sub
OLMailErr:
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub

Private Sub Mail_Click()
Dim strDest As String
Dim strObj As String
Dim strMsg As String
Dim astrFichiers(1 To 2) As String
If Me.[Franchiseur] = "MACDONALD" Then
strDest = Me.[EMAIL:]
strObj = "Franchise xx"
strMsg = "Bonjour,"bla bla"
astrFichiers(1) = "C:\xx.xlsx"
astrFichiers(2) = "C:\xx.xlsx"
SendOLMail strDest, strObj, strMsg, True, astrFichiers
ElseIf Me.[Franchiseur] = "BUFFALO GRIL" Then
strDest = Me.[EMAIL:]
strObj = "Franchisexx"
strMsg = "Bonjour," meme bla bla"
astrFichiers(1) = "C:\xx.xlsx"
astrFichiers(2) = "C:\xx.xlsx"
Else Me.[Franchiseur] = ""
MsgBox "Nom du Franchiseur manquant"
End If
SendOLMail strDest, strObj, strMsg, True, astrFichiers
End Sub

[JeanPaulR]

Re :

En fait je m'apercois que mon etiquette Franchiseur est vide quand le code la voit. Je n'ai que le retour du Msgbox et aucun envoi.
Alors que j'ai saisie sur ce formulaire le nom de ce franchiseur (visible à l'écran), par une liste de choix venant d'une table à part.
En conclusion, il faudrait arriver à capter l'information du nom du franchiseur affiché à l'ecran dans cette étiquette et qui est lié à un candidat (1 candidat = 1 franchiseur).

Merci et bonsoir

[LedZeppII]

Rebonjour,

On n'a pas le droit de mettre une condition derrière Else.
Voila une façon possible d'écrire le code :

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
Private Sub Mail_Click()
Dim strDest As String
Dim strObj As String
Dim strMsg As String
Dim strFranchiseur As String
Dim astrFichiers(1 To 2) As String
 
strDest = Nz(Me.[EMAIL:], "")
' Si email manquant
If Len(strDest)=0 Then
    MsgBox "Adresse email manquante"
    Exit Sub
End If
 
strFranchiseur = Nz(Me.[Franchiseur], "")
 
If strFranchiseur = "XXX" Then
    ' Franchiseur XXX
    strObj = "Franchise xx"
    strMsg = "Bonjour, bla bla"
    astrFichiers(1) = "C:\xx.xlsx"
    astrFichiers(2) = "C:\xx.xlsx"
    SendOLMail strDest, strObj, strMsg, True, astrFichiers
ElseIf strFranchiseur = "YYY" Then
    ' Franchiseur YYY
    strObj = "Franchisexx"
    strMsg = "Bonjour, meme bla bla"
    astrFichiers(1) = "C:\xx.xlsx"
    astrFichiers(2) = "C:\xx.xlsx"
ElseIf strFranchiseur = ""
    ' Franchiseur manquant
    MsgBox "Nom du Franchiseur manquant"
    Exit Sub
Else
    ' Franchiseur Autre
    MsgBox "Franchiseur non pris en compte"
    Exit Sub
End If
 
SendOLMail strDest, strObj, strMsg, True, astrFichiers
End Sub

Note : La fonction Nz(expression, "") sert à remplacer Null par "", dans le cas ou expression est Null.
La partie If ... Then ... Elseif ... Then ... Else ... End If gère les cas "XXX", "YYY", "", et tous les autres cas (Else).
Le Else est facultatif, mais il est prudent de le garder.
Ainsi si Me.[Franchiseur] = "ZZZ", on tombe dans le Else.
Sans le Else on arriverait à la ligne SendOLMail strDest, strObj, strMsg, True, astrFichiers, ce qui n'est sans doute pas souhaitable.

A+

[JeanPaulR]

Bonjour,

Toujours dans mes tourments ... !
La sub_mail ne me trouve pas le nom du franchiseur bien qu'il soit affiché sur mon formulaire. Elle va directement au Msgbox d'erreur.
Je pense que cela se passe au niveau de cette ligne.

Code :

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

strFranchiseur = Nz(Me.[Franchiseur], "")

En effet dans les propriétés de ce champ Franchiseur dans mon formulaire j'ai :
Source Control : Franchiseur
Contenu : SELECT [Fichier Franchiseur].[N°], [Fichier Franchiseur].[Franchiseur] FROM [Fichier Franchiseur].

Il faut passer current.record ?
Ne m'en voulez pas si je dis une bétise ..
Bonsoir

[LedZeppII]

Bonjour,

Pour une zone liste ou une une zone de liste modifiable, c'est la colonne liée qui est renvoyée.
Pour lire une colonne en particulier :

Code :

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

strFranchiseur = Nz(Me.[Franchiseur].Column(1), "")

Column(1) correspond à la 2ème colonne, donc à [Fichier Franchiseur].[Franchiseur].

A+

[JeanPaulR]

Bonjour,
Et merci bcp. C'était tout bête ..
Je vais ouvrir un nouveau sujet pour améliorer encore ma base, j'espère que je pourrais toujours compter sur votre aide.
J'ai vraiment apprécier votre pédagogie et votre patience à mon égard.
Bonne journée,
JeanPaul R