Ajout de piéce jointe avec nom changeant - macro mail excel
Résolu/Fermé
mat_7055
Messages postés
5
Date d'inscription
lundi 20 juillet 2020
Statut
Membre
Dernière intervention
20 juillet 2020
-
20 juil. 2020 à 11:13
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 20 juil. 2020 à 15:20
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 20 juil. 2020 à 15:20
A voir également:
- Ajout de piéce jointe avec nom changeant - macro mail excel
- Liste déroulante excel - Guide
- Yahoo mail - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Frédéric cherche à faire le buzz sur les réseaux sociaux. il a ajouté une image de manchots sur une image de plage. retrouvez l'image originale de la plage. que cachent les manchots ? ✓ - Forum Windows
- Trouver une adresse avec un nom de famille gratuit ✓ - Forum Mobile
3 réponses
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
20 juil. 2020 à 11:28
20 juil. 2020 à 11:28
Bonjour,
voir ceci
https://docs.microsoft.com/fr-fr/office/vba/api/excel.application.filedialog
tu récupères le chemin avec ta variable nomfic
voilà c'est tout simple
voir ceci
https://docs.microsoft.com/fr-fr/office/vba/api/excel.application.filedialog
tu récupères le chemin avec ta variable nomfic
voilà c'est tout simple
mat_7055
Messages postés
5
Date d'inscription
lundi 20 juillet 2020
Statut
Membre
Dernière intervention
20 juillet 2020
20 juil. 2020 à 12:33
20 juil. 2020 à 12:33
Merci pour ton retour cs_Le Pivert,
Je rencontre quelques soucis lors l'utilisation de cette filedialog, mais avant de te demander un petit coup de main ^^ j'aurais une question : cela va ouvrir une boite de dialogue pour trouver le chemin à chaque envoi ? ex : création de 100 PJ donc 100 boite de dialogue?
J'ai intégré le code suivant :
-----------------------------------------
Dim lngCount As Long
' Open the file dialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Next lngCount
End With
---------------------------------------
Quel ligne faut-il ajouter pour copier le chemin de le msgBox dans un variable que je pourrais reprendre dans mon .addatachement?
Je rencontre quelques soucis lors l'utilisation de cette filedialog, mais avant de te demander un petit coup de main ^^ j'aurais une question : cela va ouvrir une boite de dialogue pour trouver le chemin à chaque envoi ? ex : création de 100 PJ donc 100 boite de dialogue?
J'ai intégré le code suivant :
-----------------------------------------
Dim lngCount As Long
' Open the file dialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Next lngCount
End With
---------------------------------------
Quel ligne faut-il ajouter pour copier le chemin de le msgBox dans un variable que je pourrais reprendre dans mon .addatachement?
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
Modifié le 20 juil. 2020 à 14:38
Modifié le 20 juil. 2020 à 14:38
Comme ceci:
Tu auras juste à appeler la macro UseFileDialogOpen
et ensuite tu pourras sélectionner le nombre de fichiers que tu désires, les chemins seront séparés par un point virgule
@+ Le Pivert
Sub UseFileDialogOpen() Dim lngCount As Long Dim nomfic As String ' Open the file dialog With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show ' Display paths of each file selected For lngCount = 1 To .SelectedItems.Count Range("A" & lngCount) = .SelectedItems(lngCount) nomfic = Range("A" & lngCount) & "; " + nomfic 'affiche les chemins séparés par point virgule Next lngCount nomfic = Left(nomfic, Len(nomfic) - 2) 'supprime dernier caractere MsgBox nomfic End With End Sub
Tu auras juste à appeler la macro UseFileDialogOpen
et ensuite tu pourras sélectionner le nombre de fichiers que tu désires, les chemins seront séparés par un point virgule
@+ Le Pivert
mat_7055
Messages postés
5
Date d'inscription
lundi 20 juillet 2020
Statut
Membre
Dernière intervention
20 juillet 2020
>
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
20 juil. 2020 à 15:07
20 juil. 2020 à 15:07
Merci, je vais essayer avec cette méthode
Pour mon second probléme : la boucle, vaut-il meiux clore ce topic et en ouvrir un nouveau?
Pour mon second probléme : la boucle, vaut-il meiux clore ce topic et en ouvrir un nouveau?
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
mat_7055
Messages postés
5
Date d'inscription
lundi 20 juillet 2020
Statut
Membre
Dernière intervention
20 juillet 2020
20 juil. 2020 à 15:20
20 juil. 2020 à 15:20
Ouvre un nouveau post, parce que là on ne va rien y comprendre
mat_7055
Messages postés
5
Date d'inscription
lundi 20 juillet 2020
Statut
Membre
Dernière intervention
20 juillet 2020
20 juil. 2020 à 14:12
20 juil. 2020 à 14:12
J'ai réussià outrepasser le probléme en imposant un nom fixe à chaque PJ en fonction d'une valeur unique dans le fichier, par contre j'ai maintenant un probléme de boucle (ce que je comprend)
Dans mon exemple j'ai 4 onglet à transformer en PJ et à envoyer par mail, le soucis est que la macro stoppe aprés le 1er mail
Je précise qu'en ne renseignant que le code de création de PJ (sans la parties 'envoie de mail), la boucle fonctionne et me créer bien 4 PJ
Le soucis vient quand je rajoute le code envoie de mail et qu'il s'arrête à 1PJ créer et 1 mail envoyé
Ci dessous mon code :
---------------------
Sheets("TCD").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").ShowPages PageField:= _
"MAIL"
Do While ActiveSheet.Name <> "TCD" Or ActiveSheet.Name <> "base clients" Or ActiveSheet.Name <> "base TCD" Or ActiveSheet.Name <> "MACRO" Or ActiveSheet.Name <> "ISUZU" Or ActiveSheet.Name <> "ISUZU_2" Or ActiveSheet.Name <> "! Non Affecté !" Or ActiveSheet.Name <> "Impayés"
Dim ws As Worksheet
For Each feuille In ActiveWorkbook.Worksheets
If feuille.Name = "TCD" Or feuille.Name = "base clients" Or feuille.Name = "base TCD" Or feuille.Name = "MACRO" Or feuille.Name = "ISUZU" Or feuille.Name = "ISUZU_2" Or feuille.Name = "! Non Affecté !" Or feuille.Name = "Impayés" Then
Else
feuille.Move
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Range("B6").Select
ActiveWindow.DisplayGridlines = False
x = Range("b1").Value
y = Range("b2").Value
z = Range("d4").Value
Range("b1").Select
chemin = "chemin du fichier \"
nomfic = y
ActiveWorkbook.SaveAs Filename:=chemin & nomfic, FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close SaveChanges:=True
'PARTIE ENVOIE DE MAILS
Dim Dest As String
Dim CC As String
Dim Exp As String
Dim Suj As String
Dim Text As String
Dest = adresse mail
CC = adresse mail
Exp = adresse mail
Suj = "xxxxxxx" & y & ""
Text = "Bonjour," & vbCrLf & vbCrLf & _
"xxxxxxxx." & vbCrLf & _
"xxxxxxxxx" & vbCrLf & _
"." & vbCrLf & _
"xxxxxxxx." & vbCrLf & vbCrLf & _
"xxxxxx." & vbCrLf & vbCrLf & _
"" & vbCrLf & _
"xxxxxxxx" & vbCrLf & _
"xxxxxxx xx" & vbCrLf & _
" "
Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")
With Cdo_Message
.To = Dest
.From = Exp
.CC = CC
.Subject = Suj
.TextBody = Text
.AddAttachment ("chemin du fichier\" & y & ".xlsx")
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = xxxxxxx
'nom du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxxx"
'port du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =xxxxxxxxx
.Configuration.Fields.Update
.Send
End With
Set Cdo_Message = Nothing
MsgBox "Votre message a bien été envoyé", vbInformation
Exit Sub
err_handler:
MsgBox "Le message n'a pas pu être envoyé. Merci d'utiliser le VPN.", vbCritical
End If
Next
Loop
End Sub
------------------------------------------------------------------------------------------------
J'ai ajouté un do while + loop sans effet, je ne m'y prend surement pas de la bonne façon
Une solution?
Dans mon exemple j'ai 4 onglet à transformer en PJ et à envoyer par mail, le soucis est que la macro stoppe aprés le 1er mail
Je précise qu'en ne renseignant que le code de création de PJ (sans la parties 'envoie de mail), la boucle fonctionne et me créer bien 4 PJ
Le soucis vient quand je rajoute le code envoie de mail et qu'il s'arrête à 1PJ créer et 1 mail envoyé
Ci dessous mon code :
---------------------
Sheets("TCD").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").ShowPages PageField:= _
"MAIL"
Do While ActiveSheet.Name <> "TCD" Or ActiveSheet.Name <> "base clients" Or ActiveSheet.Name <> "base TCD" Or ActiveSheet.Name <> "MACRO" Or ActiveSheet.Name <> "ISUZU" Or ActiveSheet.Name <> "ISUZU_2" Or ActiveSheet.Name <> "! Non Affecté !" Or ActiveSheet.Name <> "Impayés"
Dim ws As Worksheet
For Each feuille In ActiveWorkbook.Worksheets
If feuille.Name = "TCD" Or feuille.Name = "base clients" Or feuille.Name = "base TCD" Or feuille.Name = "MACRO" Or feuille.Name = "ISUZU" Or feuille.Name = "ISUZU_2" Or feuille.Name = "! Non Affecté !" Or feuille.Name = "Impayés" Then
Else
feuille.Move
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Range("B6").Select
ActiveWindow.DisplayGridlines = False
x = Range("b1").Value
y = Range("b2").Value
z = Range("d4").Value
Range("b1").Select
chemin = "chemin du fichier \"
nomfic = y
ActiveWorkbook.SaveAs Filename:=chemin & nomfic, FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close SaveChanges:=True
'PARTIE ENVOIE DE MAILS
Dim Dest As String
Dim CC As String
Dim Exp As String
Dim Suj As String
Dim Text As String
Dest = adresse mail
CC = adresse mail
Exp = adresse mail
Suj = "xxxxxxx" & y & ""
Text = "Bonjour," & vbCrLf & vbCrLf & _
"xxxxxxxx." & vbCrLf & _
"xxxxxxxxx" & vbCrLf & _
"." & vbCrLf & _
"xxxxxxxx." & vbCrLf & vbCrLf & _
"xxxxxx." & vbCrLf & vbCrLf & _
"" & vbCrLf & _
"xxxxxxxx" & vbCrLf & _
"xxxxxxx xx" & vbCrLf & _
" "
Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")
With Cdo_Message
.To = Dest
.From = Exp
.CC = CC
.Subject = Suj
.TextBody = Text
.AddAttachment ("chemin du fichier\" & y & ".xlsx")
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = xxxxxxx
'nom du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxxx"
'port du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =xxxxxxxxx
.Configuration.Fields.Update
.Send
End With
Set Cdo_Message = Nothing
MsgBox "Votre message a bien été envoyé", vbInformation
Exit Sub
err_handler:
MsgBox "Le message n'a pas pu être envoyé. Merci d'utiliser le VPN.", vbCritical
End If
Next
Loop
End Sub
------------------------------------------------------------------------------------------------
J'ai ajouté un do while + loop sans effet, je ne m'y prend surement pas de la bonne façon
Une solution?