VBA envoi automatique email selon table de correspondance

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

Re : VBA envoi automatique email selon table de correspondance

Bonjour MichD,

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

("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😀

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!

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😉

Re : VBA envoi automatique email selon table de correspondance

Petite erreur de ma part : l'adresse pour l'émail de retour se trouve en feuille "Formulaire" en cellule "A14".

Soleil11😛

Re : VBA envoi automatique email selon table de correspondance

Ton fichier avec les changements effectués.

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
=========================================================

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

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

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?

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

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.

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.

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.