VBA envoi automatique email selon table de correspondance

Soleil11

XLDnaute Occasionnel
Bonjour le forum,

Dans le cadre de mon projet j'aimerais automatiser une tâche assez fastidieuse que je fais manuellement, j'ai plusieurs fichiers qui sont générés à la même place dans mon c:\data et j'aimerais prendre ces fichiers et les envoyés à des personnes différentes. Le noms de ces personnes se trouvent dans la feuille "Table email".

Dans mon fichier "Macro envoi mail" j'ai déjà un module avec un script qui existe et j'aimerais l'adapter si c'est possible.

Voici les tâches séquentiels que le macro devrait effectuer :

1. Prendre tous les fichiers en boucle qui existe sur le c:\data = Voir feuille "Critère de selection" cellule C11
2. Prendre les fichiers et les envoyer selon des addresses email qui se trouve dans ma table de correspondance en feuille "Table email" nom et email.
3. Il faudrait que la macro puisse identifier le nom et prénom de la personne qui se trouve dans le nom du fichier.
4. Cette info se trouve dans la contruction du nom du fichier qui est toujours la même: "Project Cost Accounting (Nom et Prénom) YYYY.mmm.xls"
5. Le seule "mapping" qui peut être realiser c'est le nom et prénom entre () parenthèse.
6. Si la macro trouve le nom et pénom dans ma table de correspondance il envoie le mail selon les informations qui se trouve en feuille "critère de selection" sujet, corps du message, signature.
7. Si la macro n'a pas trouvé de correspondance dans la table email Table, il envoie un message de retour à l'adresse email qui se trouve dans la feuille "Formulaire" en cellule "C14"

Je ne sais pas si cela est réalisable mais si vous avez une piste cela m'aiderait volontiers.

Merci d'avance à tout le forum.

Soleil11:confused:
 

Pièces jointes

  • Macro envoi mail.xlsm
    19.2 KB · Affichages: 58
  • Project Cost Accounting (Nom et Prénom) 2014.oct.xls
    19.2 KB · Affichages: 49

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Bonjour,

Voici ton fichier de retour.
La macro est dans le module "MichD"

Dans ton fichier "Project Cost Accounting (Nom et Prénom) YYYY.mmm.xls", inclus-tu mes frais d'honoraire?

En passant, l'extension de ton fichier est ".xlsm" et non ".xls".
 

Pièces jointes

  • Email selon table de correspondance.xlsm
    22.4 KB · Affichages: 64
  • Email selon table de correspondance.xlsm
    22.4 KB · Affichages: 79
  • Email selon table de correspondance.xlsm
    22.4 KB · Affichages: 82

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

Bonjour MichD,

J'ai un message d'erreur à la ligne du script ci-dessous:

Code:
 .To = Nom_Destinataire
("l'élément a été déplacé ou supprimé").

Pour le faire le test j'ai ajouté deux fichiers dans le folder C:\data :

  • Project Cost Accounting (Mon nom et prénom) 2014.oct.xls
  • Project Cost Accounting (Angelie Fox) 2014.oct.xls

Dans ma table de correspondance en feuille "table émail" j'ai deux lignes:

  • Mon nom et prénom - mon émail
  • Autre nom et personne - autre émail


Je reçois bien le premier fichier "Project Cost Accounting (Mon nom et prénom) 2014.oct.xls" mais pas le deuxième fichier "Project Cost Accounting (Angelie Fox) 2014.oct.xls" en retour sanchant que pour le test j'ai mis mon email en feuille "Formulaire" en cellule "A14".

Pour vos frais d'honoraire existe-t-il le moyen de faire un don sur votre site Exceldownloads pour tout le travail que vous accomplissez ?

En tout cas je vous remercie encore et encore pour votre génie et la rapidité d'avoir trouvé une solution à mon problème.

Soleil11:D
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Ben, il faut d'abord prendre le temps de décrire correctement la donne tu problème.

Dans ma table de correspondance en feuille "table émail" j'ai deux lignes:
•Mon nom et prénom - mon émail
•Autre nom et personne - autre émail

Dans ton fichier, à aucun endroit tu ne fais référence à cette autre personne.

La procédure est faite pour envoyer des courriels à la liste des personnes listés dans la colonne A à raison d'une personne par cellule. Cette liste ne doit pas contenir de doublons à défaut de quoi, les courriels se dédoubleront. Cependant, chaque nom peut avoir plusieurs fichiers dans le répertoire. Tous les fichiers ayant son nom dans ledit répertoire lui sont envoyés dans le même courriel.

Si tu veux avoir la liste des fichiers dudit répertoire qui ne sont pas liés à au moins un nom de la liste des noms contenus dans le fichier, cela est un problème différent. Il faut énoncer clairement ta demande!

Ton commentaire est incompréhensible et non conforme à la donne du problème (ma compréhension)!
Je ne saisis pas où tu trouves une erreur. Détaille les manipulations que tu exécutes et qui conduisent à cette erreur!
 
Dernière édition:

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

Rebonjour,

Je pense que la solution est presque bonne mais je vais essayer de mieux décrire ce que je veux faire.

Dans un premier temps je génère une centaine de fichiers dans mon « c:data » avec le même nom de fichier qui est construit de la façon suivante : "Project Cost Accounting (Nom et Prénom) YYYY.mmm.xls" par contre le (nom et prénom) pour chaque fichier sera différent.

Dans ma « table émail » je vais avoir une centaine de personnes avec leurs emails cette liste sera unique et sans doublons. Elle me sert de liste de contact pour envoyer tous mes emails à toutes ces personnes qui vont recevoir leurs fichiers "Project Cost Accounting (avec leur Nom et Prénom) YYYY.mmm.xls" avec un message outlook et leur fichier attaché.

Dans le cas contraire, si la macro ne trouve pas le nom et prénom de l’un des fichiers qui se trouve dans C:\data je devrais recevoir un mail en retour.

La seule façon pour moi de savoir qu’elles sont leur emails est d’avoir cette table d’équivalence feuille 1 « table émail »
Voici les séquences de la macro qui devrait correspondre à ce que je veux faire manuellement :

1. Ouvrir C:\data (Il devrait y avoir une centaine de fichiers donc la macro devrait faire une boucle sur chaque fichier)

2. 1er Fichier : il fait une recherche sur son nom avec un contient « *Nom et Prénom* »

3. 1er Fichier : Il compare avec ma feuille 1 « table émail » si le nom se trouve bien dans la colonne « A »

4. 1er Fichier : Si oui, Il trouve le nom et prénom dans ma « table émail » il prend la correspondance de son émail en colonne « B » et envoie le fichier «Project Cost Accounting (Nom et Prénom) YYYY.mmm.xls" en attaché selon les informations qu’il va trouver en feuille 2 "critère de sélection" sujet, corps du message, signature etc.

5. 1er Fichier : Dans le cas, il ne trouve aucune correspondance dans la « table émail » il renvoie en retour le fichier «Project Cost Accounting (Nom et Prénom) YYYY.mmm.xls" avec les informations qu’il va toujours trouver en feuille 2 "critère de sélection" sujet, corps du message, signature mais cette fois-ci avec l'adresse email qui se trouve en feuille "Formulaire" en cellule "C14".

6. 2ème Fichier répéter étape 1 à 5 ci-dessus.

7. 3ème Fichier répéter étape 1 à 5 ci-dessus.

J’espère avoir été plus compréhensible et plus explicite à la donne du problème.

En tout cas je vous remercie d’avance pour votre aide.

Soleil11;)
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Ton fichier avec les changements effectués.
 

Pièces jointes

  • Email selon table de correspondance.xlsm
    24.1 KB · Affichages: 72
  • Email selon table de correspondance.xlsm
    24.1 KB · Affichages: 72
  • Email selon table de correspondance.xlsm
    24.1 KB · Affichages: 59
Dernière édition:

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

Bonjour,

J'ai un message d'erreur de Type mismatch avec le nom "Aysel Ayub" voir la ligne ci-dessous et aussi un autre problème avec la référence MISSING: Microsoft Outlook 15.0 Object Library mais je l'ai désactivée et ça a l'air de fonctionné.

P = Application.Match("*" & Nom & "*", Rg, 0) =======> j'ai un message d'erreur de Type mismatch [/B]

Voici le letail des fichiers pour le test que j'ai déposé dans mons C:\data :

1. Project Cost Accounting (Aysel Ayubi) 2014.oct.xls : ( Le nom de "Aysel Ayubi" ne se trouve pas dans ma "table email" il devrait m'être renvoyé en retour)
2. Project Cost Accounting (Mon nom et prénom) 2014.oct.xls ( Ce fichier par contre devrais m'être envoyer dans ma boîte de réception car il se trouve dans ma "table email")

Le détail de ma "table email" pour le test :

Mon nom et prénom = Mon émail
Angelie = autre émail


J'ai repris votre code en modifiant les paramètres que je connais :
==============================================================
Sub test()
Dim Répertoire As String, Fichier As String, Nom As String
Dim Rg As Range, FileToSend As String, P As Long
Dim FeuilInfo As Worksheet, AdresseCourriel As String

'************* Variables à définir ***********
'Nom de la feuille à adapter si nécessaire
Set FeuilInfo = Worksheets("Formulaire")
'********************************* ***********

Répertoire = "C:\Data" ' FeuilInfo.Range("A11")
If Right(Répertoire, 1) <> "\" Then
Répertoire = Répertoire & "\"
End If

Fichier = Dir(Répertoire)
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With Worksheets("Table Email")
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

Fichier = Dir(Répertoire & "*.xl*")
Do While Fichier <> ""
Nom = Nom_Usager(Fichier)
If Nom <> "" Then
P = Application.Match("*" & Nom & "*", Rg, 0) =======> j'ai un message d'erreur de Type mismatch
If IsNumeric(P) Then
AdresseCourriel = Rg(P).Offset(, 1)
FileToSend = Répertoire & Fichier
Else
Err.Clear
AdresseCourriel = FeuilInfo.Range("A14")
FileToSend = Répertoire & Fichier
End If
Else
AdresseCourriel = FeuilInfo.Range("A14")
FileToSend = Répertoire & Fichier
End If
EnvoiCourriel FeuilInfo, AdresseCourriel, FileToSend
Fichier = Dir()
Loop
Set Rg = Nothing: Set FeuilInfo = Nothing
Set objOutlook = Nothing: Set objMail = Nothing
End Sub

Sub EnvoiCourriel(FeuilInfo As Worksheet, AdresseCourriel As String, FileToSend As String)
With objMail
.to = AdresseCourriel
.Subject = CStr(FeuilInfo.Range("A2"))
.Body = CStr(FeuilInfo.Range("A5"))
If FileToSend <> "" Then
.Attachments.Add FileToSend
End If
.Send
'.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
End Sub

Function Nom_Usager(NomFichier As String) As String
Dim Y As Long, Z As Long, GestionErreur As String
On Error GoTo GestionErreur
With Application
Y = .Find("(", NomFichier)
Z = .Find(")", NomFichier) - 1
End With
Nom_Usager = Mid(NomFichier, Y + 1, Z - Y)
Exit Function

GestionErreur:
Err.Clear
Nom_Usager = ""
End Function
=========================================================
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

L'erreur n'est pas à la ligne que tu as indiquée, mais dans la déclaration de la variable P en tout début de procédure.
Au lieu de définir la variable comme ceci : P As Long il faut la modifier comme ceci : P As Variant
 

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

Nous y sommes presque, à présent je peux continuer avec F8 et cela marche à merveille il me renvoie le fichier "Project Cost Accounting (Aysel Ayubi) 2014.oct.xls" avec l'adresse email de retour en celulle "A14" la condition fonctionne.

Et cela bloque de nouveau, nous avons le même message qu'en début de discussion : "l'élément a été déplacé ou supprimé".

la ligne concernée par ce message est la suivante :

.to = AdresseCourriel =("l'élément a été déplacé ou supprimé")

Est-ce qu'il ne trouve plus l'objet attaché "Project Cost Accounting (Mon nom et prénom) 2014.oct.xls" qui est définit en "FileToSend as string" pour l'envoyer à mon adresse émail ?

Décidement, je ne pensais que cela serait aussi compliqué.

Merci quand même de votre aide vous avez vraiment de la patience.

Soleil11
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Je n'ai pas testé la procédure, je n'ai pas ton environnement pour le faire...

.to = AdresseCourriel

Quelle est la valeur de "AdresseCourriel" lorsque tu passes la souris au-dessus?

Est-ce que cette adresse existe vraiment?
 

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

Mon adresse email existe vraiment, elle se trouve dans ma table email et lorsque je passe la souris sur FileToSend je trouve aussi l'object en question qui est le fichier C:\Data\Project Cost Accounting (Mon nom et prénom) 2014.oct.xls qui doit m'être envoyé.

Sub EnvoiCourriel(FeuilInfo As Worksheet, AdresseCourriel As String, FileToSend As String) '=> si je passe la souris sur FileToSend la valeur est la suivante :FiletoSend = C:\Data\Project Cost Accounting (Mon nom et prénom) 2014.oct.xls

With objMail
.to = AdresseCourriel '=> si je passe la souris sur AdresseCourriel la valeur est la suivante : Mon nom et Prénom@gamail.com
.Subject = CStr(FeuilInfo.Range("A2"))
.Body = CStr(FeuilInfo.Range("A5"))
If FileToSend <> "" Then
.Attachments.Add FileToSend
End If
.Send
'.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
End Sub
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Bonjour,

J'ai modifié très légèrement la procédure... Est-ce possible que la cellule contenant ce nom contienne des caractères ne faisant pas partie de l'adresse courriel comme des espaces, des retours à la ligne...etc?

La procédure bloque à cet endroit pour seulement une adresse particulière ou pour toutes les adresses. Je me suis créé un exemple réel et je n'ai aucun problème particulier avec cette ligne de code ou autres lignes de code.

La procédure a été testée rapidement à partir de Microsoft Office 2013.
 

Pièces jointes

  • email selon table de correspondance.xlsm
    23 KB · Affichages: 42
  • email selon table de correspondance.xlsm
    23 KB · Affichages: 54
  • email selon table de correspondance.xlsm
    23 KB · Affichages: 53

Soleil11

XLDnaute Occasionnel
Re : VBA envoi automatique email selon table de correspondance

J'ai copié l'entier du module dans mon fichier et j'ai relancé F5 et toujours le même message : ("l'élément a été déplacé ou supprimé").

Dans mon adresse émail il y un caractère "Nom.prénom@gmail.com" peut-être c'est cela qui pose problème mais j'ai essayé aussi avec une adresse qui ne contient pas de "." et cela ne fonctionne pas.

La procédure est testée avec MS Office 2010.
 

MichD

XLDnaute Impliqué
Re : VBA envoi automatique email selon table de correspondance

Essaie cette version. J'ai pu reproduire l'erreur que tu as relevée. Chez moi, tout est OK.
 

Pièces jointes

  • email selon table de correspondance.xlsm
    23.4 KB · Affichages: 60
  • email selon table de correspondance.xlsm
    23.4 KB · Affichages: 73
  • email selon table de correspondance.xlsm
    23.4 KB · Affichages: 71

Discussions similaires

Réponses
2
Affichages
234

Statistiques des forums

Discussions
311 727
Messages
2 081 962
Membres
101 852
dernier inscrit
dthi16088