VBA outlook : Envoi de mails selon critère

Résolu/Fermé
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 - 21 avril 2023 à 20:02
 Profil bloqué - 24 avril 2023 à 01:41

Bonjour,

Je dois envoyer des e-mails à 2 destinataires avec des pièces jointes. Chaque destinataire a ses pièces jointes stockées dans un dossier à part qui eux meme sont dans un dossier pricipal.

Le code suivant devrait faire ce travail, mais j'ai une erreur de débogage à la ligne

dossierDestinataire = Dir()

avant le dernier loop. Pouvez-vous m'aider s'il vous plait.

voici le code :

Sub EnvoyerEmailAvecPieceJointe()

    ' Définir le chemin d'accès au dossier principal contenant les sous-dossiers de chaque destinataire
    Dim dossierPrincipal As String
    dossierPrincipal = "D:\Pieces jointes\"
    
    ' Boucler sur les sous-dossiers pour envoyer un email à chaque destinataire
    Dim dossierDestinataire As String
    Dim destinataire As String
    Dim monMessage As Outlook.MailItem
    Dim fichier As String
    
    dossierDestinataire = Dir(dossierPrincipal & "*", vbDirectory)
    
    Do While Len(dossierDestinataire) > 0
        If dossierDestinataire <> "." And dossierDestinataire <> ".." Then
            
            ' Définir le destinataire en fonction du nom du sous-dossier
            Select Case dossierDestinataire
                Case "D1": destinataire = "Destinataire1@abc.com"
                Case "D2": destinataire = "Destinataire2@ijk.com"
                ' Ajouter d'autres cas pour chaque destinataire et chaque dossier
            End Select
            
            ' Créer un nouvel email pour ce destinataire
            Set monMessage = Application.CreateItem(olMailItem)
            
            ' Définir les destinataires, le sujet et le corps de l'email
            monMessage.To = destinataire
            monMessage.Subject = "TEST"
            monMessage.Body = "Ce mail est un test, Merci d'ignorer"
            
            ' Ajouter les pièces jointes du dossier correspondant à ce destinataire
            fichier = Dir(dossierPrincipal & dossierDestinataire & "\", vbNormal)
            Do While Len(fichier) > 0
                If fichier <> "." And fichier <> ".." Then
                    monMessage.Attachments.Add dossierPrincipal & dossierDestinataire & "\" & fichier
                End If
                fichier = Dir()
            Loop
            
            ' Envoyer l'email
            monMessage.Send
            
        End If
    dossierDestinataire = Dir()
    Loop

End Sub

A voir également:

17 réponses

hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
22 avril 2023 à 10:46

Bonjour,

j'ai oublié de préciser que j'ai outlook 2016

Merci de votre aide habituelle.

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
Modifié le 22 avril 2023 à 12:49

Bonjour,

Pouvez-vous indiquer le texte d'erreur ?


0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
22 avril 2023 à 14:41

Bonjour,

Suite essai simulé selon ce que j'ai compris, essayer avec ce code (modifier boucle sur fichier)

Sub EnvoyerEmailAvecPieceJointe()

    ' Définir le chemin d'accès au dossier principal contenant les sous-dossiers de chaque destinataire
    Dim dossierPrincipal As String
    dossierPrincipal = "D:\Jean-Pierre\Bureau\Test_hmcirta\" '"D:\Pieces jointes\"
    
    ' Boucler sur les sous-dossiers pour envoyer un email à chaque destinataire
    Dim dossierDestinataire As String
    Dim destinataire As String
  '  Dim monMessage As Outlook.MailItem
    Dim fichier As String
    
    dossierDestinataire = Dir(dossierPrincipal & "*", vbDirectory)
    
    Do While Len(dossierDestinataire) > 0
        If dossierDestinataire <> "." And dossierDestinataire <> ".." Then
            
            ' Définir le destinataire en fonction du nom du sous-dossier
            Select Case dossierDestinataire
                Case "D1": destinataire = "Destinataire1@abc.com"
                Case "D2": destinataire = "Destinataire2@ijk.com"
                ' Ajouter d'autres cas pour chaque destinataire et chaque dossier
            End Select
            
            ' Créer un nouvel email pour ce destinataire
            Set monMessage = Application.CreateItem(olMailItem)
            
            ' Définir les destinataires, le sujet et le corps de l'email
            monMessage.To = destinataire
            monMessage.Subject = "TEST"
            monMessage.Body = "Ce mail est un test, Merci d'ignorer"
            
            ' Ajouter les pièces jointes du dossier correspondant à ce destinataire
'***** Modification Le Pingou
Dim Wk As Object
Dim rep As Object
Dim Chemin As String
    Chemin = dossierPrincipal & dossierDestinataire 'ThisWorkbook.Path
    Set rep = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

    For Each Wk In rep.Files
        monMessage.Attachments.Add Wk
    Next
            
'            fichier = Dir(dossierPrincipal & dossierDestinataire & "\", vbNormal)
'            Do While Len(fichier) > 0
'                If fichier <> "." And fichier <> ".." Then
'                    monMessage.Attachments.Add dossierPrincipal & dossierDestinataire & "\" & fichier
'                End If
'                fichier = Dir()
'            Loop
'**** fin modification

            ' Envoyer l'email
            monMessage.Send
            
        End If
    dossierDestinataire = Dir()
    Loop

End Sub

0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
Modifié le 22 avril 2023 à 15:58

Bonjour

Merci de ton aide Le Pingou

dans mon code la ligne :

dossierDestinataire = Dir()

renvoi l'erreur de débogage "Argument ou appel de procédure incorrect"

Pour ta proposition, la ligne :

monMessage.Attachments.Add Wk

renvoi l'erreur de débogage : Propriété ou méthode non gérée par cet objet

0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
22 avril 2023 à 15:51

Bonjour,

Dans ma proposition du poste 3, ne pas oublier de rétablir la ligne :

​
dossierPrincipal = "D:\Jean-Pierre\Bureau\Test_hmcirta\" '"D:\Pieces jointes\"

​Corriger:
​
dossierPrincipal = "D:\Pieces jointes\"

​

0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
Modifié le 22 avril 2023 à 17:54

Bonjour, 

oui ça été fait.

Dans mon code le premier message est bien envoyé au destinataire qu'il faut, c'est au moment où le code passe au 2eme dossier que ça bug.

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
Modifié le 22 avril 2023 à 18:27

Bonjour,

Avez-vous essayé le code que j'ai modifié au poste 3 ... Oui /Non ou sa sert à rien....!

La boucle sur les fichiers ne peut pas se faire avec Dir() car dès que vous revenez sur prochain dossier le Dir() reste référencé sur répertoire des fichier....!


0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
22 avril 2023 à 18:51

Bonjour,

Oui je l'avais essayé et je t'ai repondu au poste 4.

Bien entendu j'ai corrigé "dossierPrincipal" par "D:\pieces jointes" 

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
Modifié le 22 avril 2023 à 19:06

Bonjour,

Merci du retour, sur ma simulation tout fonctionne correctement pour chaque destinataire je reçois tous ses fichiers

Par contre je ne peut pas tester l'envoi du message ....manque des éléments que je ne connais pas...!

Est-il possible d'avoir une copie d'écran ou se produit la faute...?


0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
Modifié le 22 avril 2023 à 19:22

En faisant cette petite modification ca m'affiche correctement les fichiers de chaque dossier dans la fenetre execution, et les emails partent sans pieces jointes.

    For Each Wk In rep.Files
    Debug.Print Wk
        'monMessage.Attachments.Add Wk
    Next

mais avec ca :

    For Each Wk In rep.Files
'    Debug.Print Wk
        monMessage.Attachments.Add Wk
    Next

j'ai le débogage

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
22 avril 2023 à 22:30

Bonsoir.

En relisant le code je pense que celà vient de ceci, la variable monMessage est neutralislée 


0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
23 avril 2023 à 10:15

Bonjour,

J'ai réactivé la ligne et c'est le même message à la même ligne qui s'affiche

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
23 avril 2023 à 10:51

Bonjour,

Je vais voir si j'arrive à faire fonctionner l'envoi de message  chez moi (pour l'instant cela ne fonctionne pas)...!


0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
23 avril 2023 à 11:14

Bonjour,

Je pense que j'ai trouvé, 

'Modifier
monMessage.Attachments.Add Wk
'Par
monMessage.Attachments.Add dossierPrincipal & dossierDestinataire & "\" & Wk.Name

0
hmcirta Messages postés 237 Date d'inscription dimanche 12 mars 2006 Statut Membre Dernière intervention 7 novembre 2024 21
23 avril 2023 à 15:21

Bonjour 

NICKEL !!

Ca fonctionne très bien, ....

Merci beaucoup Le Pingou, tu vas me faire gagner un temps considérable.

0
Le Pingou Messages postés 12241 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 19 février 2025 1 458
23 avril 2023 à 16:00

Bonjour,

Merci du retour. 

Pensez de marquer comme résolu si c'est le cas.......!


0

Il n'est pas possible d'envoyer des mails selon des critères spécifiques dans Outlook. Cependant, vous pouvez créer des règles pour organiser vos messages entrants et sortants, et automatiser certaines tâches.

je vous remercie de votre visite et espère que vous avez trouvé les informations que vous cherchiez. N'hésitez pas à revenir si vous avez d'autres questions ou besoins.

0