Envoi mail avec 2 pièces jointes et utilisation compte mail spécifique

**vinch974** · 13/08/2023, 17h29

Bonjour à tous et merci d'avance pour votre aide.

Je suis une bille en vba mais je ne peux pas faire autrement pour ma demande. Donc pour ceux qui auront la gentillesse de m'aider, merci de me donner la syntaxe complète svpl.

J'ai obtenu l'aide d'une personne pour créer un module vba pour envoyer un état en pdf par mail. Celui-ci fonctionne parfaitement.

Malheureusement, je ne peux plus compter sur cette bonne âme pour continuer. Voici mon code actuel

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
 
'------------------------------------------------------------
' mail_cde_usine
'
'------------------------------------------------------------
Function mail_cde_usine()
On Error GoTo mail_cde_usine_Err
 
    With CodeContextObject
        ' Ouvrir le rapport
        DoCmd.OpenReport "Commande usine", acViewReport, "", "[Commandes usines]![No d'ordre]=[Forms]![Comm usine]![No d'ordre]", acHidden
 
        ' Exporter le rapport en tant que fichier PDF temporaire
        Dim tempPath As String
        tempPath = Environ("Temp") & "\" & "Commande usine.pdf"
        DoCmd.OutputTo acOutputReport, "Commande usine", acFormatPDF, tempPath
 
        ' Adresse e-mail du destinataire
        Dim mailContactValue As String
        mailContactValue = IIf(IsNull(Forms![Comm usine]![mail contact]), "", Forms![Comm usine]![mail contact])
 
        ' Appel de la fonction pour envoyer le rapport par e-mail via Outlook
        EnvoyerCdeUsineParEmail mailContactValue, tempPath
 
        ' Fermer le rapport
        DoCmd.Close acReport, "Commande usine"
 
        ' Supprimer le fichier PDF temporaire
        Kill tempPath
    End With
 
mail_cde_usine_Exit:
    Exit Function
 
mail_cde_usine_Err:
    MsgBox Error$
    Resume mail_cde_usine_Exit
 
End Function
 
'------------------------------------------------------------
' EnvoyerCdeUsineParEmail
'
'------------------------------------------------------------
Sub EnvoyerCdeUsineParEmail(mailContactValue As String, rapportPath As String)
    ' Déclaration des objets Outlook
    Dim outlookApp As Object
    Dim outlookMail As Object
 
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")
 
    ' Création d'un nouvel objet Mail
    Set outlookMail = outlookApp.CreateItem(0)
 
    ' Configuration du mail
    With outlookMail
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
        .To = mailContactValue
        .Subject = "Commande " & IIf(Forms![Comm usine]!su = 1, "NE-", "VE-") & Forms![Comm usine]![No d'ordre] & " " & Forms![Comm usine]!fournabr & " / réf : " & Forms![Comm usine]!ref
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add rapportPath ' Ajoute l'attachement PDF du rapport
    End With
 
    ' Libération des objets Outlook
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub

Aujourd'hui je souhaite pouvoir intégrer 2 états à mon mail ... J'ai tenté de copier les fonctions d'ouverture d'état et de conversion mais j'ai un problème avec la fonction Attachments.Add ....

De plus, j'aimerais pouvoir forcer l'utilisation d'un compte mail Exchange spécifique pour l'envoi (et non pas le compte par défaut d'Outlook). Il faudrait donc que je retrouve mon mail dans les éléments envoyés de cette adresse aussi. L'adresse du compte souhaité se trouve comme contrôle dans mon formulaire (Forms!menu!sf_user!mail_user). J'ai vu qu'on devrait pouvoir utiliser la fonction SendUsingAccount mais je patauge totalement à intégrer cela ...

Je vous remercie infiniment d'avance pour votre aide.

Vinch

**User** · 14/08/2023, 18h01

Bonjour,

Pour l'ajout de 2 fichiers en attachement à partir de 2 arguments rapportPath1 et rapportPath2, normalement il faut juste répéter la commande :

Code :

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

1
2
3
4
...
.Attachments.Add rapportPath1 ' Ajoute l'attachement PDF du rapport1
.Attachments.Add rapportPath2 ' Ajoute l'attachement PDF du rapport2
...

**vinch974** · 14/08/2023, 22h12

Bonsoir User et merci beaucoup pour l'aide.

Après quelques remaniements dans la création de tempPath1 et tempPath2 (en fait, le temps que je comprenne ce que je pouvais et devais corriger ...), cela fonctionne parfaitement !

Merci sincèrement.

Concernant la 2e partie de ma demande (envoyer le mail depuis une adresse forcée) pouvez-vous m'indiquer la façon de procéder ? Peut-être en utilisant la commande SendUsingAccount ?

Si oui, merci de me donner la syntaxe complète car je nage complétement.

Merci d'avance et bonne soirée.

Vinch

**User** · 15/08/2023, 11h20

Bonjour,

Il faudrait créer un objet NameSpace pour parcourir les comptes de messagerie.

Pour un compte ayant comme adresse de messagerie "dupont@gmail.com", ça donnerait ce code pour la procédure :

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
Sub EnvoyerCdeUsineParEmail(mailContactValue As String, rapportPath1 As String, , rapportPath2 As String)
    ' Déclaration des objets Outlook
    Dim outlookApp As Object
    Dim outNameSpace As Object ' ajout d'une variable objet NameSpace
    Dim outlookMail As Object
 
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")
 
    ' création de l'objet Namesapce
    Set outNameSpace = outlookApp.GetNamespace("MAPI")
 
    ' Création d'un nouvel objet Mail
    Set outlookMail = outlookApp.CreateItem(0)
 
    # parcours des différents comptes du Namespace	
    For Each oAccount In outNameSpace.Accounts
        If oAccount.SmtpAddress = "dupont@gmail.com" Then
            outlookMail.SendUsingAccount = oAccount ' affectation du compte sur la propriété SendUsingAccount
            Exit For ' sort de la boucle
        End If
    Next
 
    ' Configuration du mail
    With outlookMail
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
        .To = mailContactValue
        .Subject = "Commande " & IIf(Forms![Comm usine]!su = 1, "NE-", "VE-") & Forms![Comm usine]![No d'ordre] & " " & Forms![Comm usine]!fournabr & " / réf : " & Forms![Comm usine]!ref
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add rapportPath1 ' Ajoute l'attachement PDF du rapport1
        .Attachments.Add rapportPath1 ' Ajoute l'attachement PDF du rapport2
    End With
 
    ' Libération des objets Outlook
    Set outlookMail = Nothing
    Set outNameSpace = Nothing
    Set outlookApp = Nothing
 
End Sub

Pour plus d'infos, vous pouvez faire une recherche avec par exemple les mots-clés :

SendUsingAccount vba outlook

**vinch974** · 17/08/2023, 14h51

Merci User pour votre réponse.

Malheureusement, cela ne fonctionne pas. Je suis en train de faire des recherches avec les mots clés proposés mais je patauge sincèrement (Il y a tellement de façons de faire différentes que je ne sais pas à quoi me référer...).

Ce que je trouve bizarre, c'est que, dans le nouveau message qui s'ouvre, le texte de l'adresse de l'expéditeur est en gris alors que tout le reste est en noir ...

A savoir : Mon compte par défaut est un compte Microsoft Exchange. Dans Outlook, l'option envoyer message avec le compte par défaut est décoché.
Le compte que je souhaite utiliser pourrait être un compte IMAP ou un autre compte Microsoft Exchange.

Si vous avez une idée c'est bien volontiers ...

**User** · 17/08/2023, 15h21

Bonjour,

Pouvez-vous poster votre code actuel ?

Il ne trouve pas le compte ?

Y-a-t-il un message d'erreur ?

Note : j'aurais mis le display à la fin du bloc with.

Cdlt,

**vinch974** · 17/08/2023, 17h09

Merci beaucoup pour le suivi.

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
'------------------------------------------------------------
' mail_fact
'
'------------------------------------------------------------
Function mail_fact()
On Error GoTo mail_fact_Err
 
    With CodeContextObject
        ' Ouvrir le rapport
        DoCmd.OpenReport "Facture mail", acViewReport, "", "[Info factures]![No fact]=[Forms]![factures]![No fact]", acHidden
 
        ' Exporter le rapport en tant que fichier PDF temporaire
        Dim tempPath As String
        tempPath = Environ("Temp") & "\" & "Facture.pdf"
        DoCmd.OutputTo acOutputReport, "Facture mail", acFormatPDF, tempPath
 
        ' Adresse e-mail du destinataire
        Dim mailContactValue As String
        mailContactValue = IIf(IsNull(Forms![factures]![Texte126]), "", Forms![factures]![Texte126])
 
        ' Appel de la fonction pour envoyer le rapport par e-mail via Outlook
        EnvoyerFactParEmail mailContactValue, tempPath
 
        ' Fermer le rapport
        DoCmd.Close acReport, "Facture mail"
 
        ' Supprimer le fichier PDF temporaire
        Kill tempPath
    End With
 
mail_fact_Exit:
    Exit Function
 
mail_fact_Err:
    MsgBox Error$
    Resume mail_fact_Exit
 
End Function
 
'------------------------------------------------------------
' EnvoyerFactParEmail
'
'------------------------------------------------------------
Sub EnvoyerFactParEmail(mailContactValue As String, rapportPath As String)
    ' Déclaration des objets Outlook
    Dim outlookApp As Object
    Dim outNameSpace As Object ' Ajout d'une variable objet NameSpace
    Dim outlookMail As Object
 
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")
 
    ' Création de l'objet NameSpace
    Set outNameSpace = outlookApp.GetNamespace("MAPI")
 
    ' Création d'un nouvel objet Mail
    Set outlookMail = outlookApp.CreateItem(0)
 
    ' Parcours des différents comptes du Namspace
    For Each oAccount In outNameSpace.Accounts
        If oAccount.SmtpAddress = "vinch@beaumont10.ch" Then ' ou Forms!viper!F_list_user![mail défaut]
            outlookMail.SendUsingAccount = oAccount ' affectation du compte sur la propriété SendUsingAccount
            Exit For ' sort de la boucle
        End If
    Next
 
    ' Configuration du mail
    With outlookMail
        .To = mailContactValue
        .Subject = "Facture n° " & Forms![factures]![No fact] & " du " & Forms![factures]![Date]
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add rapportPath ' Ajoute l'attachement PDF du rapport
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
    End With
 
    ' Libération des objets Outlook
    Set outlookMail = Nothing
    Set outNameSpace = Nothing
    Set outlookApp = Nothing
 
End Sub

(J'ai corrigé le display à la fin)

Je n'ai pas de message d'erreur ... Le compte demandé est existant je vous assure. Mais c'est le compte par défaut qui s'affiche.

Merci d'avance

**User** · 17/08/2023, 19h29

C'est vrai qu'on navigue un peu à vue, difficile de trouver la bonne info.

Si le compte exchange est accessible dans la session active d'Outlook, j'essaierais de changer dans la procédure EnvoyerFactParEmail la partie pour parcourir les comptes, en utilisant cette fois la session outlook en cours :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'...
 
    ' Parcours des différents comptes de la session outlook
    For Each oAccount In outlookApp.Session.Accounts
    ' For Each oAccount In outNameSpace.Accounts
        If oAccount.SmtpAddress = "vinch@beaumont10.ch" Then ' ou Forms!viper!F_list_user![mail défaut]
            outlookMail.SendUsingAccount = oAccount ' affectation du compte sur la propriété SendUsingAccount
            Exit For ' sort de la boucle
        End If
    Next
 
'...

Je vous donne 2 liens utiles :

https://learn.microsoft.com/fr-fr/of...ndusingaccount

Dans celui-ci :

https://www.developpez.net/forums/d1...t/#post7796272

Oliv- propose de faire à la place de la boucle directement :

Code :

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

Set oAccount = outlookApp.Session.Accounts("vinch@beaumont10.ch")

Je n'ai pas testé...

**vinch974** · 17/08/2023, 22h52

Bonsoir User et merci infiniment pour le temps consacré à m'aider.

Malheureusement, les 2 propositions ne fonctionnent pas. Rien n'y fait, c'est toujours le compte par défaut qui est utilisé ...

J'ai essayé à tâtons de modifier le code avec les liens transmis mais sans succès.

Par contre, j'ai trouvé l'article suivant :

http://https://learn.microsoft.com/f...ew=outlook-pia

Je ne sais pas cette instruction correspond à la mienne de "CreateItem" mais la remarque indiqué :

La méthode CreateItem peut uniquement créer des éléments Outlook par défaut. Pour créer des éléments à l’aide d’un formulaire personnalisé, utilisez la Add(Object) méthode sur la Items collection.

Est-ce que le compte utilisé pour l'envoi fait partie de ces éléments par défaut ??? Si oui, savez-vous comment modifier mon code ?

Merci d'avance

**vinch974** · 17/08/2023, 22h57

Je précise qu'actuellement je fais mes tests en essayant de faire passer un compte IMAP (vinch@beaumont10.ch) en remplacement du compte par défaut qui est un compte Exchange privé ...

Mais une fois réussi et mis à jour pour mes 10 utilisateurs, mon application devra pouvoir remplacer un compte Exchange privé par un compte IMAP ou un compte Exchange partagé ...

**vinch974** · 18/08/2023, 08h44

Bonjour,

J'ai tenté d'insister ce matin avec la version d'oliv ...

Au moins avec celle-là j'ai une erreur qui se produit (et pas juste un brouillon qui s'ouvre avec le compte par défaut)

Voici mon code actuel avec les points modifiés en rouge

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
Sub EnvoyerFactnoParEmail(mailContactValue As String, rapportPath As String)
    ' Déclaration des objets Outlook
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim oAccount As Object
        
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' Création d'un nouvel objet Mail
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' Choix du compte mail
    Set oAccount = outlookApp.Session.Accounts("vinch@beaumont10.ch")
    
    ' Configuration du mail
    With outlookMail
        .To = mailContactValue
        .SendUsingAccount = oAccount
        .Subject = "Facture n° " & Forms![Visuel par no fact]![No fact] & " du " & Forms![Visuel par no fact]![Date]
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add rapportPath ' Ajoute l'attachement PDF du rapport
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
    End With
    
    ' Libération des objets Outlook
    Set outlookMail = Nothing
    Set outlookApp = Nothing

End Sub

(j'ai supprimé tout ce qui avait un lien avec outNameSpace)

Je ne peux pas mettre (comme oliv) : Dim oAccount As Outlook.Account / ça coince ... (également avec oAccount as OutlookApp.Account)
ni : Set oAccount = Application.Session.Accounts("test@test.com") / ça coince aussi ...

Et voici l'erreur que je reçois
Nom : Capture d'écran 2023-08-18 082811.png
Affichages : 147
Taille : 5,9 Ko

Nom : Capture d'écran 2023-08-18 082811.png
Affichages : 147
Taille : 5,9 Ko

Merci d'avance de votre aide ...

**User** · 18/08/2023, 10h26

Bonjour,

Avec un compte exchange il parle d'utiliser SentOnBehalfOfName :

.SentOnBehalfOfName = "vinch@beaumont10.ch"

À la place de :

.SendUsingAccount = oAccount

Sinon souhaitez-vous que je transfert la discussion dans le forum Outlook ?

**vinch974** · 18/08/2023, 14h01

Merci du suivi User.

En supprimant tout ce qui concerne oAccount et en remplaçant seulement SendUsingAccount par SentOnBehalfOfName, ça semble fonctionner.

Mais ...

Nom : Capture d'écran 2023-08-18 135431.png
Affichages : 135
Taille : 2,4 Ko

Nom : Capture d'écran 2023-08-18 135431.png
Affichages : 135
Taille : 2,4 Ko

Ce n'est pas ce que je souhaite ... il faut vraiment que ce soit le compte qui soit utilisé (pour retrouver les éléments envoyés à la bonne place) et pas un pseudo alias ...

Donc volontiers pour un déplacement du sujet si vous pensez que ça peut aider ...

Merci encore.

Vinch

**vinch974** · 18/08/2023, 14h26

J'ai trouvé cela sur un autre forum avec exactement le même problème que moi mais résolu. En plus l'article date de 2022 donc on devrait bien pouvoir s'en inspirer ...

https://social.msdn.microsoft.com/Fo...ys?forum=vbafr

J'ai bien ajouté la référence Microsoft Outlook 16.0 Object Library dans mon module VBA et tenté de tester avec les informations de hier soir car je ne comprends pas comment ils arrivent à quoi dans cet article ...

Peut-être que vous si ...

**tee_grandbois** · 18/08/2023, 15h11

bonjour,

J'ai bien ajouté la référence Microsoft Outlook 16.0 Object Library dans mon module VBA et tenté de tester avec les informations de hier soir car je ne comprends pas comment ils arrivent à quoi dans cet article

déjà, si tu postais le code complet avec les dernières modifications, cela aiderait peut-être à te suivre, car il y a pas mal de références à des codes source différents ...

**vinch974** · 19/08/2023, 07h12

Bonjour tee_grandbois et merci d'avance pour le temps consacré à m'aider.

Voici mon code actuel :

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
'------------------------------------------------------------
' mail_factno
'
'------------------------------------------------------------
Function mail_factno()
On Error GoTo mail_factno_Err
 
    With CodeContextObject
        ' Ouvrir le rapport
        DoCmd.OpenReport "Facture mail", acViewReport, "", "[Info factures]![No fact]=[Forms]![Visuel par no fact]![No fact]", acHidden
 
        ' Exporter le rapport en tant que fichier PDF temporaire
        Dim tempPath As String
        tempPath = Environ("Temp") & "\" & "Facture.pdf"
        DoCmd.OutputTo acOutputReport, "Facture mail", acFormatPDF, tempPath
 
        ' Adresse e-mail du destinataire
        Dim mailContactValue As String
        mailContactValue = IIf(IsNull(Forms![Visuel par no fact]![Texte126]), "", Forms![Visuel par no fact]![Texte126])
 
        ' Appel de la fonction pour envoyer le rapport par e-mail via Outlook
        EnvoyerFactnoParEmail mailContactValue, tempPath
 
        ' Fermer le rapport
        DoCmd.Close acReport, "Facture mail"
 
        ' Supprimer le fichier PDF temporaire
        Kill tempPath
    End With
 
mail_factno_Exit:
    Exit Function
 
mail_factno_Err:
    MsgBox Error$
    Resume mail_factno_Exit
 
End Function
 
'------------------------------------------------------------
' EnvoyerFactnoParEmail
'
'------------------------------------------------------------
Sub EnvoyerFactnoParEmail(mailContactValue As String, rapportPath As String)
    ' Déclaration des objets Outlook
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim oAccount As Outlook.Account
 
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")
 
    ' Création d'un nouvel objet Mail
    Set outlookMail = outlookApp.CreateItem(0)
 
    ' Choix du compte mail
    Set oAccount = outlookApp.Session.Accounts("vinch@beaumont10.ch")
 
    ' Configuration du mail
    With outlookMail
        .To = mailContactValue
        .SendUsingAccount = oAccount
        .Subject = "Facture n° " & Forms![Visuel par no fact]![No fact] & " du " & Forms![Visuel par no fact]![Date]
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add rapportPath ' Ajoute l'attachement PDF du rapport
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
    End With
 
    ' Libération des objets Outlook
    Set outlookMail = Nothing
    Set outlookApp = Nothing
 
End Sub

**loufab** · 19/08/2023, 15h50

Bonjour,

Code :

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

1
2
3
4
5
6
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim oAccount As Outlook.Account
 
    ' Création d'une instance de l'application Outlook
    Set outlookApp = CreateObject("Outlook.Application")

et

J'ai bien ajouté la référence Microsoft Outlook 16.0 Object Library

Il faudrait déjà comprendre le concept de early et late binding, là il y a un joli mélange des 2 qui ne sert strictement à rien.

http://blogaccess.free.fr/?p=127

Vu la description du problème c'est plutôt l'utilisation de la bibliothèque Outlook sans la connaissance nécessaire ou de son utilisation avec des types différents de config de server mail, qu'un problème de référence.

Dans tous les cas cette question n'a rien à faire dans Access. C'est une bibliothèque Outlook il fallait poster dans le forum VBA d'Outlook.

Cordialement,

**vinch974** · 20/08/2023, 14h35

C'est bon j'ai trouvé.

Merci pour votre aide.

**loufab** · 21/08/2023, 09h31

Bonjour,

N'hésite pas à partager ta solution, cela intéresse surement d'autres lecteurs.

Cordialement,

**vinch974** · 22/08/2023, 08h38

Voici mon code complet permettant l'envoi de 2 fichiers joints (2 Etats converti en pdf sans stockage) en utilisant un autre compte (existant) que le compte par défaut 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
84
85
86
87
88
'------------------------------------------------------------
' mail_2files
'
'------------------------------------------------------------
Function mail_2files()
On Error GoTo mail_2files_Err

    With CodeContextObject
        ' Ouvrir le rapport
        DoCmd.OpenReport "Nom de l'état 1", acViewReport, "", "Condition where", acHidden 
        
        ' Exporter le rapport en tant que fichier PDF temporaire
        Dim tempPath1 As String
        tempPath1 = Environ("Temp") & "\" & "Nom personnalisé 1.pdf"
        DoCmd.OutputTo acOutputReport, "Nom de l'état 1", acFormatPDF, tempPath1

        ' Ouvrir le rapport
        DoCmd.OpenReport "Nom de l'état 2", acViewReport, "", "Condition where", acHidden
        
        ' Exporter le rapport en tant que fichier PDF temporaire
        Dim tempPath2 As String
        tempPath2 = Environ("Temp") & "\" & "Nom personnalisé 2.pdf"
        DoCmd.OutputTo acOutputReport, "Nom de l'état 2", acFormatPDF, tempPath2

        ' Adresse e-mail de l'expéditeur
        Dim mailExpValue As String
        mailExpValue = Forms!mon_form![mail défaut] ' ou "test@test.com"
        
        ' Adresse e-mail du destinataire
        Dim mailContactValue As String
        mailContactValue = IIf(IsNull(Forms!mon_form!mail_cli), "", Forms!mon_form!mail_cli)
        
        ' Appel de la fonction pour envoyer le rapport par e-mail via Outlook
        Envoyer2filesParEmail mailContactValue, mailExpValue, tempPath1, tempPath2
        
        ' Fermer le rapport
        DoCmd.Close acReport, "Nom de l'état 1"
        DoCmd.Close acReport, "Nom de l'état 2"
        
        ' Supprimer le fichier PDF temporaire
        Kill tempPath1
        Kill tempPath2
    End With

mail_2files_Exit:
    Exit Function

mail_2files_Err:
    MsgBox Error$
    Resume mail_2files_Exit

End Function

'------------------------------------------------------------
' Envoyer2filesParEmail
'
'------------------------------------------------------------
Sub Envoyer2filesParEmail(mailContactValue As String, mailExpValue As String, rapportPath1 As String, rapportPath2 As String)
    ' Déclaration des objets Outlook
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutAccount As Outlook.Account
    
    ' Création d'une instance de l'application Outlook
    Set OutApp = CreateObject("Outlook.Application")
    
    ' Création d'un nouvel objet Mail
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    ' Choix du compte mail
    Set OutAccount = OutApp.Session.Accounts(mailExpValue)
    
    ' Configuration du mail
    With OutMail
        .To = mailContactValue
        .Subject = "Votre sujet"
        .HTMLBody = "<br>" & .HTMLBody
        .SendUsingAccount = OutAccount
        .Attachments.Add rapportPath1 ' Ajoute l'attachement PDF du rapport
        .Attachments.Add rapportPath2 ' Ajoute l'attachement PDF du rapport
        .Display ' Affiche le message pour vérification avant envoi. Utilisez .Send pour envoyer directement sans vérification.
    End With
    
    ' Libération des objets Outlook
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set OutAccount = Nothing
End Sub

N'oubliez pas de référencer la bibliothèque "Microsoft Outlook 16.0 Object Library"

Envoi mail avec 2 pièces jointes et utilisation compte mail spécifique

VBA Outlook

Discussions similaires

Partager

Partager