Envoi mail avec outlook , et choisir plusieurs fichiers dans fenêtres
Bonsoir ,
Je bosse comme ambulancier dans une infirmerie d´un parc d´attractions. Chaque jour , je dois faire des rapports concernant mes activités ,
des objets perdus , etc.
Je me suis adapté un fichier excel par fonction pour me préparer des amils envoyés par outlook sur le pc de mon bureau ... Jusque là tout va bien , le vba fonctionne mais ne me donne que la possibilité de choisir un fichier dans une fenêtre . Mais pour bien faire , je devrais pouvoir en envoyer 3 voire 4 ...
Je vous donne mon vba qui fonctionne :
Option Explicit
Sub EnvoiMail()
Dim ListeDest()
Dim ListeComment()
Dim i As Long
Dim oMsgApp As Object
Dim oMsg As Object
Dim sListeDest As String
Dim sFichier As String
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If sFichier = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
Set oMsgApp = CreateObject("Outlook.Application")
ListeDest() = Range("tblBase[Mail]")
ListeComment() = Range("tblBase[Commentaire]")
For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
Set oMsg = oMsgApp.CreateItem(0)
With oMsg
.To = ListeDest(i, 1)
.Attachments.Add sFichier
.Subject = "Rapport du jour ...."
.Body = "" & Chr(10) & Chr(13) & _
ListeComment(i, 1) & Chr(10) & Chr(13) & "Bonne journée"
.Display
.Send
End With
Set oMsg = Nothing
Next
oMsgApp.Quit
Set oMsgApp = Nothing
MsgBox "Mail envoyé"
End Sub
Maintenant , si je mets 3 ou 4 fois la fonction suivante l´une derrière l´autre :
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If sFichier = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
Là je bloque car je n´ai plus de suite , dois je faire
End Sub
End if
Pour que la suite fonctionne aussi ?
Merci de máider .
Fschauer21
Bonjour,
En faisant çà, vous allez écraser la valeur précédente, voyer plutôt avec le paramètre multiselect (voir le lien)
https://msdn.microsoft.com/fr-fr/vba/excel-vba/articles/application-getopenfilename-method-excel
L'écriture serait plutôt comme ça (nb : pour en sélectionner plusieurs, n'oubliez pas de maintenir la touvhe Ctrl
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer", , True)Cordialement
Bonjour Besoin_d_aide ,
Merci pour votre réponse , mais vu que je ne suis que très petit débutant dans le vba d´excel , je vais devoir un peu plus me renseigner sur le code multiselect , comme j´ai su lire sur la page que vous m´avez donné comme lien , True autoriserait plusieurs fichiers .
Ce qui est vraiment dommage , que je ne sais pas tester la fonction à mon domicile , car je n´ai pas d´outlook installé sur le pc ... Et je ne reprends le travail que jeudi .
Donc au lieu d´avoir :
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If sFichier = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
je devrais avoir :
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer", , True)
If sFichier = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
qui me donnerait la possibilité de saisir plusieurs fichiers comme pièces jointes au mail généré par le vab , si je comprends bien ?
Et donc aussi m´ouvrir la fenêtre pour saisir les fichiers à plusieures reprises jusqu´à avoir sélectionné les fichiers voulus et cliquer "fini" ou "annuler" ?
Mon problème est que les fichiers sont dans différents dossiers sur le pc du bureau , mais au besoin je pourrais les rassembler dans un seul dossier si cela aide à les saisir avec moins de difficultés ...
Merci de ton aide ,
Bonne soirée ,
Fschauer21
Re,
Si vous voulez ouvrir une fenêtre jusqu'à cliquer sur finis ou annuler, suivez la procédure suivante
Couper coller le code cité plus haut dans une macro à part (que j'ai appelé sélection dans l'exemple)
Sub selection
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer", , True)
If sFichier = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
end subEnsuite, remplacer le code couper dans votre macro par le suivant
while msgbox("voulez vous sélectionner un autre fichier ?", vbYesNo, "Sélection") = vbyes
call selection
wendAinsi, vous n'aurez pas besoin de rassembler les fichier (sauf si voulez "ranger" un peu votre pc
Ps : si jamais la sélection de plusieurs fichier ne fonctionne pas (que seul le dernier fichier enregistré est sélectionné, essayé le code suivant
sFichier = sFichier & Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer", , True)Cordialement
Bonjour Besoin_d_aide ,
Je viens de lire to post , et je vois qu´une solution se présente , mais comme dit je ne reprends que le travail ce jeudi ...
Mais là je ne capte pas bien , couper quoi pour le coller où ?
Faire une macro supplémentaire dans le même module de la macro ou dans un nouveau module ?
Avez vous outlook installé sur votre pc ?
Voulez vous mon fichier pour essayer ?
Que pouvons nous faire pour ne pas comfondre les choses ?
Merci de votre aide ,
Fschauer21
Re,
Mais là je ne capte pas bien , couper quoi pour le coller où ?
Faire une macro supplémentaire dans le même module de la macro ou dans un nouveau module ?
En fait, je vous demandes de couper votre macro en 2. De cette façon, il suffit d’insérer la boucle while...wend dans votre macro Envoimail.
Grâce à ça, vous pourrez sélectionner tous les fichier qu vous voulez
Avez vous outlook installé sur votre pc ?
Voulez vous mon fichier pour essayer ?
Je n'ai pas outlook sur celui ci mais sur un autre PC. Envoyé le fichier, je testerai dans la soirée.
Codialement
Bonjour Besoin_d_aide
Merci pour ton aide , je viens d'essayer les changements dans le vba et voilà ce que j'obtiens:
Il me surligne sFichier et m'indique par fenêtre : Erreur de compilation: Variable non définie.
Je te joins le fichier pour que tu puisses y jeter un oeil , histoire de voir ce que j'ai fait faux , de même 2 yeux de plus voyent mieux (surtout les erreurs)...
Je pense que nous ne sommes pas loin de la solution ...
Bonne journée et merci de tes précieux conseils/aides ,
Fschauer21
Bonjour ,
Je viens de fuiner un peu concernant l'envoi d'émails avec plusieurs fichiers attachés et je suis parvenu à trouver ceci:
'Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
'attache des fichiers: adaptez oEmail a votre programme
oEmail.Attachments.Add .SelectedItems(lngCount)
Next lngCount
End With
Ce pourrait être une bonne piste , mais cela devrait être adapté à mon vba ...
Probablement plus besoin de faire une macro à part pour choisir les fichiers ....
Qui peut m'aider ?
Bonne journée ,
Fschauer21
Bonjour à tous ,
Le petit code du post avant ne fonctionne pas ...
Mais en fuinant un peu plus , je déniche ceci :
Nom_Fichier1 = Application.GetOpenFilename("Classeurs Excel , *.xls")
Nom_Fichier2 = Application.GetOpenFilename("Classeurs Excel , *.xls")
et
.Attachments.Add Nom_Fichier1
.Attachments.Add Nom_Fichier2
Qui pourrait être une bonne piste aussi , puisque l'on nomme plusieurs fichiers , donc si on fait .Attachments.Add suivi du nom du fichier saisi avec GetOpenFilename , on arriverait à joindre autant de fichiers à condition de savoir combien il en faut ...
Je vais tester dans mes temps libres en modifiant ma macro ...
Je vous tiens au courant.
Bonne journéee à tous ,
Fschauer21
Rebonjour à tous ,
Donc ma piste était bonne :
j'ai modifié la macro , et ici s'ouvre 3 fois une fenêtre pour choisir un fichier à joindre au mail et le résultat est :
Option Explicit
Sub EnvoiMail()
Dim ListeDest()
Dim ListeComment()
Dim i As Long
Dim oMsgApp As Object
Dim oMsg As Object
Dim sListeDest As String
Dim Nom_Fichier1 As String
Dim Nom_Fichier2 As String
Dim Nom_Fichier3 As String
Nom_Fichier1 = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If Nom_Fichier1 = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
Nom_Fichier2 = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If Nom_Fichier2 = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
Nom_Fichier3 = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If Nom_Fichier3 = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
End If
Set oMsgApp = CreateObject("Outlook.Application")
ListeDest() = Range("tblBase[Mail]")
ListeComment() = Range("tblBase[Commentaire]")
For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
Set oMsg = oMsgApp.CreateItem(0)
With oMsg
.To = ListeDest(i, 1)
.Attachments.Add Nom_Fichier1
.Attachments.Add Nom_Fichier2
.Attachments.Add Nom_Fichier3
.Subject = "Rapport du jour..."
.Body = "" & Chr(10) & Chr(13) & _
ListeComment(i, 1) & Chr(10) & Chr(13) & ""
.Display
End With
Set oMsg = Nothing
Next
End Sub
Donc c'est une macro EnvoiMail avec avant l' OptionExplicit ....
Si il faut plus ou moins de pièces jointes , il faut ajouter/retirer le bloc:
Nom_Fichier3 = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
If Nom_Fichier3 = "" Then
MsgBox "Aucun fichier sélectionné, opération annulée"
Exit Sub
Et aussi enlever/ajouter au dessus Dim Nom_Fichier3 As String ....
Puis ne pas oublier le End If pour que le reste fonctionne....
Explications du fonctionnement :
sur la feuille 1 , dans la colonne H "commentaires" se met le corps du message , avec même passage à la ligne en faisant alt+enter...
dans la colonne I "mail" , on y introduit une ou plusieurs adresses mail séparées de point-virgules comme la syntaxe d'outlook ...
Dans la macro , on peut mettre entre les" " Bonjour , ainsi que la formule de politesse pour la fin du mail ...
Je vous mets le fichier excel en pièce jointe,
Merci à tous ceux qui ont aidé à faire la macro ...
Bonne journée à tous ,
Fschauer21