Envoi fichiers via macro VBA

Le 27/04/2020 à 11:39

Bonjour à tous,

J'aurais besoin d'aide car je souhaiterais envoyer des fichiers PDF en masse via une macro comme suit en cliquant sur le bouton "Envoyer" :

1. La macro va chercher à l'emplacement en cellule E1 le fichier contenant entre autres le texte de la cellule A3 et envoie le fichier PDF trouvé à l'adresse mail en cellule B3

Par exemple un fichier intitulé "SUP1 blablabla" serait mis en pièce-jointe du mail à destination de SUP1

2. Ainsi de suite pour tous les noms dans la colonne A

J'aimerais également que le mail envoyé automatiquement soit dans une langue présélectionnée en cellule I1 et que le contenu du mail soit selon la langue sélectionnée le texte en cellule B1 de la Feuil1 si l'anglais a été sélectionné, etc.

Merci par avance pour votre aide !

J'ai mis le fichier en pièce-jointe

23fichier-envoi.xlsm (21.22 Ko)
Le 28/04/2020 à 09:26

Bonjour

Quelqu'un saurait-il m'aider avec VBA ?

Merci par avance !

Le 28/04/2020 à 11:20

Bonjour

je ne sais pas si je vais pouvoir t'aider dans l'intégralité... mais bon on va essayé de faire avance le problème...

1°) emplacement du dossier... il faudrait que dans ta cellule il y ait le chemin complet... exemple

"C:\users\fred\desktop"'

2) les fichiers pdf à trouver il y a forcement 1 seul fichier par correspondant ? ou il peut y en avoir plusieurs ??

une fois les réponses on pourra essayé d'avancé quelque chose

Fred

Le 28/04/2020 à 11:27

Bonjour,

Je veux bien t'aider mais je n'utilise plus outlook, donc je ne pourrai pas tester.

Par contre je peux te guider dans la résolution de ton sujet.

jewlesd a écrit :

J'aimerais également que le mail envoyé automatiquement soit dans une langue présélectionnée en cellule I1 et que le contenu du mail soit selon la langue sélectionnée le texte en cellule B1 de la Feuil1 si l'anglais a été sélectionné, etc.

Ajoute en I1 de DATA

=EQUIV(H1;Feuil1!A:A;0)

cela facilitera la macro.

ensuite

.Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
jewlesd a écrit :

1. La macro va chercher à l'emplacement en cellule E1 le fichier contenant entre autres le texte de la cellule A3 et envoie le fichier PDF trouvé à l'adresse mail en cellule B3

Par exemple un fichier intitulé "SUP1 blablabla" serait mis en pièce-jointe du mail à destination de SUP1

2. Ainsi de suite pour tous les noms dans la colonne A

Quels sont les emplacements possibles (cellule E1) ?

edit : bonjour Fred, on se rejoint dans nos interrogations

Le 28/04/2020 à 11:30

Salut Steelson

Fred

Le 28/04/2020 à 11:38
Steelson a écrit :

Bonjour,

Je veux bien t'aider mais je n'utilise plus outlook, donc je ne pourrai pas tester.

Par contre je peux te guider dans la résolution de ton sujet.

jewlesd a écrit :

J'aimerais également que le mail envoyé automatiquement soit dans une langue présélectionnée en cellule I1 et que le contenu du mail soit selon la langue sélectionnée le texte en cellule B1 de la Feuil1 si l'anglais a été sélectionné, etc.

Ajoute en I1 de DATA

=EQUIV(H1;Feuil1!A:A;0)

cela facilitera la macro.

ensuite

.Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
jewlesd a écrit :

1. La macro va chercher à l'emplacement en cellule E1 le fichier contenant entre autres le texte de la cellule A3 et envoie le fichier PDF trouvé à l'adresse mail en cellule B3

Par exemple un fichier intitulé "SUP1 blablabla" serait mis en pièce-jointe du mail à destination de SUP1

2. Ainsi de suite pour tous les noms dans la colonne A

Quels sont les emplacements possibles (cellule E1) ?

edit : bonjour Fred, on se rejoint dans nos interrogations

Merci Steelson !

Les emplacements possibles seront choisis par les différents utilisateurs de la macro à priori... probablement leur Bureau...

L'idée serait qu'ils viennent copier coller le chemin d'accès aux fichiers PDF (qui pourrait être le même que le fichier Excel contenant la macro) dans la cellule E1

14fichier-envoi.xlsm (37.76 Ko)
Le 28/04/2020 à 12:11

Re bonjour

il manque toujours la réponse à :

2) les fichiers pdf à trouver il y a forcement 1 seul fichier par correspondant ? ou il peut y en avoir plusieurs ??

et es-tu prêt, ou est-ce que cela sera possible d'utiliser Outlook comme client de messagerie ?

Fred

Le 28/04/2020 à 12:13

Essaie ceci ...

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, nf As String, repertoire As String, pj As Variant, pj2 As String

    Set myapp = CreateObject("Outlook.Application")

    repertoire = Range("E1")

    For i = 6 To 1000

    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Le tite de la fenêtre:"
        .InitialFileName = "*" & Range("A" & i) & "*.pdf"
        .InitialView = msoFileDialogViewProperties
        .Show
        pj = .SelectedItems(1)
    End With

        Set myItem = myapp.CreateItem(0) '0 = mailItem
        Varcellvalue = Range("B" & i) & " - " & Range("C" & i)
        nf = Dir(repertoire & Varcellvalue & ".pdf") 'on vérifie si fichier existe
        If nf <> "" Then  'si fichier existe
            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With
        End If
    Next i

End Sub
Le 28/04/2020 à 12:59
Steelson a écrit :

Essaie ceci ...

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, nf As String, repertoire As String, pj As Variant, pj2 As String

    Set myapp = CreateObject("Outlook.Application")

    repertoire = Range("E1")

    For i = 6 To 1000

    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Le tite de la fenêtre:"
        .InitialFileName = "*" & Range("A" & i) & "*.pdf"
        .InitialView = msoFileDialogViewProperties
        .Show
        pj = .SelectedItems(1)
    End With

        Set myItem = myapp.CreateItem(0) '0 = mailItem
        Varcellvalue = Range("B" & i) & " - " & Range("C" & i)
        nf = Dir(repertoire & Varcellvalue & ".pdf") 'on vérifie si fichier existe
        If nf <> "" Then  'si fichier existe
            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With
        End If
    Next i

End Sub

Voici ce qui s'affiche lorsque je lance la macro :

capture vba

Ce que je souhaiterais c'est que la macro aille chercher le mot "SUP1" dans une liste de fichiers PDF puis joigne le fichier contenant ce mot à un mail qui s'enverrait automatiquement à l'adresse mail associée à SUP1, idem pour "SUP2", etc.

Encore merci pour ton aide

11fichier-envoi.xlsm (36.52 Ko)
Le 28/04/2020 à 13:11

D'abord, mets ta macro en adéquation avec ton fichier ....

Pourquoi

For i = 6 To 1000

???????????

alors que les données vont de la ligne 3 à 5 !

Le 28/04/2020 à 13:18
Steelson a écrit :

D'abord, mets ta macro en adéquation avec ton fichier ....

Pourquoi

For i = 6 To 1000

???????????

alors que les données vont de la ligne 3 à 5 !

Ah ça c'est parcequ'il risque d'y avoir des centaines de lignes - la data que j'ai insérée est un data test...

Le 28/04/2020 à 13:21

mais cela ne doit pas indiquer **.pdf s'il y avait quelque chose en colonne A !

Le 28/04/2020 à 14:26

Autre version

Ajoute cette fonction

Function PieceJointe(critere As String, extension As String)
Dim MonRepertoire$, Repertoire As FileDialog, monFichier$

    PieceJointe = ""

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Function
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    monFichier = Dir(MonRepertoire & "*." & extension)
    Do While monFichier <> "" And Not PieceJointe Like "*" & critere & "*"
        PieceJointe = (MonRepertoire & monFichier)
        monFichier = Dir
    Loop

End Function

et modifie le code comme suit :

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, nf As String, repertoire As String, pj As Variant, pj2 As String

    Set myapp = CreateObject("Outlook.Application")

    repertoire = Range("E1")

    For i = 3 To 5

        pj = PieceJointe(Range("A" & i).value, "pdf")

        Set myItem = myapp.CreateItem(0) '0 = mailItem
        Varcellvalue = Range("B" & i) & " - " & Range("C" & i)
        nf = Dir(repertoire & Varcellvalue & ".pdf") 'on vérifie si fichier existe
        If nf <> "" Then  'si fichier existe
            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With
        End If
    Next i

End Sub
Le 29/04/2020 à 06:09

Autre version ... à tester et mettre au point car je ne travaille plus avec outlook.

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, pj As Variant
Dim MonRepertoire$, Repertoire As FileDialog, monFichier$

    PieceJointe = ""

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set myapp = CreateObject("Outlook.Application")

    For i = 3 To 5

    monFichier = Dir(MonRepertoire & "*.pdf")
    Do While monFichier <> "" And Not pj Like "*" & critere & "*"
        pj = (MonRepertoire & monFichier)
        monFichier = Dir
    Loop
    If Not pj Like "*" & critere & "*" Then 
        msgbox "ligne " & i & " fichier pas trouvé !"
    else

        Set myItem = myapp.CreateItem(0) '0 = mailItem
        Varcellvalue = Range("B" & i) & " - " & Range("C" & i)

            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With

    end if
    Next i

End Sub
Le 29/04/2020 à 09:19
Steelson a écrit :

Autre version ... à tester et mettre au point car je ne travaille plus avec outlook.

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, pj As Variant
Dim MonRepertoire$, Repertoire As FileDialog, monFichier$

    PieceJointe = ""

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set myapp = CreateObject("Outlook.Application")

    For i = 3 To 5

    monFichier = Dir(MonRepertoire & "*.pdf")
    Do While monFichier <> "" And Not pj Like "*" & critere & "*"
        pj = (MonRepertoire & monFichier)
        monFichier = Dir
    Loop
    If Not pj Like "*" & critere & "*" Then 
        msgbox "ligne " & i & " fichier pas trouvé !"
    else

        Set myItem = myapp.CreateItem(0) '0 = mailItem
        Varcellvalue = Range("B" & i) & " - " & Range("C" & i)

            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With

    end if
    Next i

End Sub

Merci Steelson !

Le message d'erreur suivant s'affiche pour ce code-ci :

capture vba 2

Saurais-tu pourquoi ?

Le 29/04/2020 à 09:54

parce que pas défini, supprime cette ligne

j'ai testé à partir de ce fichier ... mais pour la transposition à l'aveugle, pas facile !

10piece-jointe-nom-partiel.xlsm (15.95 Ko)
Le 29/04/2020 à 11:22
Steelson a écrit :

parce que pas défini, supprime cette ligne

j'ai testé à partir de ce fichier ... mais pour la transposition à l'aveugle, pas facile !

Désolée je ne vois pas ce que je dois faire...

Voici mon fichier jusqu'à maintenant avec le code que tu m'as envoyé - je souhaiterais que la macro aille chercher les fichiers PDF via le chemin entré en cellule E1

10fichier-envoi.xlsm (37.48 Ko)

Pour l'instant la macro s'arrête ici :

capture vba 3
Le 29/04/2020 à 11:48

La macro te demande le dossier que tu choisis dans ton PC .... car dans ta zone tu as mis bureau et il ne le reconnait pas !

Le 29/04/2020 à 12:11

Bonjour...

en revient donc toujours a ma première remarque d'hier....

fred2406 a écrit :

1°) emplacement du dossier... il faudrait que dans ta cellule il y ait le chemin complet... exemple

"C:\users\fred\desktop"'

on pourrais éventuellement faire une macro qu'il faut lancer une première fois avant de lancer la macro Steelson qui enregistre le chemin dans la cellule...

en fait extraire du code actuel la partie qui demande de choisir le dossier en enregistrer le chemin dans la cellule E....

Fred

Le 29/04/2020 à 12:49

Puisqu'en E1 il y a maintenant un chemin complet ...

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myItem As Object, i As Long
Dim Varcellvalue As String, pj As Variant
Dim MonRepertoire$, monFichier$

    MonRepertoire = Range("E1") & "\"

    Set myapp = CreateObject("Outlook.Application")

    For i = 3 To 5

    monFichier = Dir(MonRepertoire & "*.pdf")
    Do While monFichier <> "" And Not pj Like "*" & critere & "*"
        pj = (MonRepertoire & monFichier)
        monFichier = Dir
    Loop
    If Not pj Like "*" & critere & "*" Then
        MsgBox "ligne " & i & " fichier pas trouvé !"
    Else

        Set myItem = myapp.CreateItem(0) '0 = mailItem

            With myItem
                .Subject = Range("A" & i) & "facture"
                .To = Range("B" & i)
                .Body = Replace(Sheets("Feuil1").Range("B" & Range("I1").Value).Value, "XX", Range("A" & i).Value)
                .Attachments.Add pj '& ".pdf"
                .Display
                .Send
            End With

    End If
    Next i

End Sub
22fichier-envoi.xlsm (24.22 Ko)
Rechercher des sujets similaires à "envoi fichiers via macro vba"