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