VBA outlook : Envoi de mails selon critère

Bonjour,

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

Merci de votre aide habituelle.

Bonjour,

Pouvez-vous indiquer le texte d'erreur ?

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

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

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\"

​

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.

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....!

Bonjour,

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

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

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...?

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

Bonsoir.

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

Bonjour,

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

Bonjour,

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

Bonjour,

Je pense que j'ai trouvé, 

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

Bonjour 

NICKEL !!

Ca fonctionne très bien, ....

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

Bonjour,

Merci du retour. 

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

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.