Macro exécutercode avec VBA

Version imprimable

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:

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

13/05/2012, 18h52
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:

1 2 3 Sub Nom() ... End Sub
Fonction:
Code:

1 2 3 Function Nom() ... End Function
Il faut aussi remplacer les Exit Sub par Exit Function.

A+

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:

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

Bonsoir,

Le code de la fonction doit ressembler à ceci :
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 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:

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:

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:

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:

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

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+

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:

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

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:

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:

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:

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:

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+

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:

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

17/05/2012, 20h11
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

Rebonjour,

On n'a pas le droit de mettre une condition derrière Else.
Voila une façon possible d'écrire le code :
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 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+

18/05/2012, 16h36
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:

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
19/05/2012, 11h53
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:

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

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

A+
20/05/2012, 12h03
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