Envoyer des fichiers par mail avec une liste sur Excel
Bonjour à tous,
J’aimerais un code VBA qui me permettrait de réaliser ceci :
J’ai un fichier Excel qui comporte une colonne « A » avec des N° et une colonne « B » avec une ou plusieurs adresse emails.
Je voudrais envoyer aux adresses mail de la colonne B des fichiers qui comportent dans son intitulé ces n° de la colonne A et qui arriveraient dans le répertoire suivant «C :\Users\name\Documents\Nouveau Dossier »
la première chose à faire serait de transformer ces fichiers txt en xlsx. Ce sont les fichiers xlsx qui seraient envoyés
les intitulés des fichiers contiennent le N° : la regle serait fichier contient N°
exemple : N° 742539 / nom du fichier AB122294_1122_test_0000742539_05_2019_2018_20190905_083425_529366.txt
NB : il peut y avoir plusieurs fois le même N° ou il se peut que le n° ne se trouve pas dans les fichiers
J’aimerais indiquer dans l’objet du mail « Statistiques de consommation » et mettre un message dans le corps du mail « Bonjour, veuillez trouver ci-joint votre statistique de consommation »
En pièce jointe vous trouverez le fichier Excel (les adresse mails sont fictives) et les exemples de fichiers à faire partir.
Merci d’avance
Bonjour Raphdas,
Les fichiers à expédier sont-ils dans le même dossier que l'EXCEL ou bien ?
Bonjour Gvialles,
non les fichiers sont dans un répertoire à part. J'avais pensé le mettre ici : «C :\Users\name\Documents\Nouveau Dossier »
mais ça peut être ailleurs. C'est comme vous voulez. Le plus simple pour vous
j'espère avoir été clair
merci d'avance
Bonjour Raphdas,
Je propose :
- de créer 3 plages nommées (>Formules>Gestionnaire de noms...) :
Et le code suivant :
Option Explicit
Sub ScanComptes()
Dim oFS As Scripting.Filesystemobject
Dim oFolder As Scripting.Folder
Dim oFiles As Scripting.Files
Dim oFile As Scripting.File
Dim sPath As String
Dim oRange As Range, oCell As Range
Dim sCompte As String
'On affecte la variable pour l'objet "FileSystemObject"
Set oFS = CreateObject("Scripting.FileSystemObject")
'On récupère le nom du dossier contenant les fichiers
sPath = ThisWorkbook.Names("Dossier_Fichiers").RefersToRange.Value
'On affecte la variable pour l'objet "Dossier"
Set oFolder = oFS.GetFolder(sPath)
'On affecte la variable permettant l'accès à tous les fichiers du dossier
Set oFiles = oFolder.Files
For Each oCell In ActiveSheet.Range(ActiveSheet.Cells(2, 1), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1))
sCompte = CStr(oCell.Value)
'On contrôle que le compte n'est pas vide
If Len(sCompte) > 0 Then
'On recherche un fichier dont le nom contient le compte
For Each oFile In oFiles
If InStr(1, oFile.Name, sCompte) > 0 Then
'Si on le trouve, on l'expédie vers les eMail contenu dans la ligne
SendFile oFile.Path, oCell.Offset(, 1).Value
End If
Next
End If
Next
End Sub
Sub SendFile(zfileName As String, zTo As String)
Const olMailItem = 0
Dim oOL As Object
Dim oMail As Object
Dim sSubject As String, sBody As String
PreparerOutlook oOL
'On récupère le sujet et le texte du mail
sSubject = ThisWorkbook.Names("ObjetMail").RefersToRange.Value
sBody = ThisWorkbook.Names("TextMail").RefersToRange.Value
'On créé un nouveau mail
Set oMail = oOL.CreateItem(olMailItem)
With oMail
.To = zTo
.Subject = sSubject
.Body = sBody
'On attache le fichier
.Attachments.Add zfileName
.display 'Si on veut envoyer immédiatement : à remplacer par .send
End With
Set oMail = Nothing
Set oOL = Nothing
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------
On Error GoTo PreparerOutlookErreur
On Error Resume Next
'vérification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")
If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
Else 'si Outlook est ouvert, l'instance existante est utilisée
Set oOutlook = GetObject("Outlook.Application")
'oOutlook.Visible = True
End If
Exit Sub
PreparerOutlookErreur:
MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub
Je joins mon classeur de test.
Et, au cas où, une version du code en "later binding" pour FileSystemObject
Option Explicit
Sub ScanComptes()
Dim oFS As Object
Dim oFolder As Object
Dim oFiles As Object
Dim oFile As Object
Dim sPath As String
Dim oRange As Range, oCell As Range
Dim sCompte As String
'On affecte la variable pour l'objet "FileSystemObject"
Set oFS = CreateObject("Scripting.FileSystemObject")
'On récupère le nom du dossier contenant les fichiers
sPath = ThisWorkbook.Names("Dossier_Fichiers").RefersToRange.Value
'On affecte la variable pour l'objet "Dossier"
Set oFolder = oFS.GetFolder(sPath)
'On affecte la variable permettant l'accès à tous les fichiers du dossier
Set oFiles = oFolder.Files
For Each oCell In ActiveSheet.Range(ActiveSheet.Cells(2, 1), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1))
sCompte = CStr(oCell.Value)
'On contrôle que le compte n'est pas vide
If Len(sCompte) > 0 Then
'On recherche un fichier dont le nom contient le compte
For Each oFile In oFiles
If InStr(1, oFile.Name, sCompte) > 0 Then
'Si on le trouve, on l'expédie vers les eMail contenu dans la ligne
SendFile oFile.Path, oCell.Offset(, 1).Value
End If
Next
End If
Next
End Sub
Sub SendFile(zfileName As String, zTo As String)
Const olMailItem = 0
Dim oOL As Object
Dim oMail As Object
Dim sSubject As String, sBody As String
PreparerOutlook oOL
'On récupère le sujet et le texte du mail
sSubject = ThisWorkbook.Names("ObjetMail").RefersToRange.Value
sBody = ThisWorkbook.Names("TextMail").RefersToRange.Value
'On créé un nouveau mail
Set oMail = oOL.CreateItem(olMailItem)
With oMail
.To = zTo
.Subject = sSubject
.Body = sBody
'On attache le fichier
.Attachments.Add zfileName
.display 'Si on veut envoyer immédiatement : à remplacer par .send
End With
Set oMail = Nothing
Set oOL = Nothing
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------
On Error GoTo PreparerOutlookErreur
On Error Resume Next
'vérification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")
If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
Else 'si Outlook est ouvert, l'instance existante est utilisée
Set oOutlook = GetObject("Outlook.Application")
'oOutlook.Visible = True
End If
Exit Sub
PreparerOutlookErreur:
MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub
Bonjour GVIALLES
un grand merci. C'est franchement balèze. J'ai testé les deux ça fonctionne. Sauf que le fichier envoyé est en txt. J'aurais voulu qu'il se transforme en xlsx avant et qu'il soit envoyé en xlsx. Ensuite si on a un N° en doublon j'aurais voulu qu'il envoie les deux fichiers dans un même mail. Mais sur ce dernier point c'est pas encore trop grave si ce n'est pas faisable. C'est surtout le Txt transformé en XLSX qui m'importe.
merci
Raphdas,
Les fichiers txt que tu as joint sont tous vides.
Peux-tu fournir un exemple non vide?
ha oui effectivement. j'avais voulu vider les fichiers volontairement.
Voici un fichier en exemple
merci
Raphdas,
Ton fichier n'est pas formaté de façon à être directement converti en xlsx.
Il y a 11 lignes d'entête, une ligne d'entêtes des colonnes puis les lignes de données "utiles".
Il n'y a pas de caractère de délimitation de texte...
Le caractère de délimitation des champs est " " (un espace). Ceci ne permet pas de découper correctement en colonnes puisque les champs eux-mêmes comportent des espaces.
Si tu tentes de convertir en EXCEL, tu obtiens un xlsx "mal foutu" comme celui que je joins.
désolé
voici un vrai txt pouvant être transformé en xlsx