Pièce jointe à partir du chemin spécifié dans une cellule

[cgpa]

Bonjour !
En vba, je sais piloter Outlook et joindre un fichier spécifique avec '.Attachments.Add "Chemin de mon fichier".
Pour une raison de facilité, j'aimerais cependant pouvoir spécifier le chemin du fichier dans la cellule A1 de la "Feuil1", mais malgré mes essais et recherches, je ne parviens pas à dire en VBA qu'il faut prendre le chemin spécifié dans la cellule A1 de la feuille 1. Pouvez-vous m'aider? Merci beaucoup et excellente journée.

 

[Roland_M]

re

je ne sais plus ouvrir les modules !
comme tu sais l'ouvrir il faut que tu fasses un copier/coller de tout le code du module en question, ou simplement ma macro, et que tu le colles ici !

 

[cgpa]

Voici le module concerné.
je ne comprends également pas ("Envoyer Mail aux fourisseurs",..): à quoi sert ce code?

Public Sub BoutonEnvoiMail()
If ActiveCell.Value = "" Then MsgBox "Merci de sélectionner une ligne dans le tableau": Exit Sub
ChoixDestin$ = Trim(LCase(Cells(ActiveCell.Row, "W"))) 'trim() pour suppr espace et lcase() pour test tout en minuscule
If ChoixDestin$ = "commande fournisseur" Then
If MsgBox("Envoyer Mail aux fournisseurs", vbQuestion + vbYesNo, "Envoi Mail") = vbYes Then Envoyer_Mail_CdeFournisseur Else Exit Sub
ElseIf ChoixDestin$ = "commande sous-traitant" Then
If MsgBox("Envoyer Mail aux sous-traitants", vbQuestion + vbYesNo, "Envoi Mail") = vbYes Then Envoyer_Mail_CdeST Else Exit Sub
Else
If ChoixDestin$ = "" Then
M$ = "Il n'y a aucune valeur dans le type de courrier !?"
Else: M$ = "La valeur dans le type de courrier n'est pas valide !?"
End If
MsgBox M$, vbExclamation, "erreur": Exit Sub
End If
End Sub


' Fournisseur
Sub Envoyer_Mail_CdeFournisseur()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
'Exemple pour envoyer un classeur en pièce jointe
'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
'Ou bien entrer le path et nom du fichier autrement
Nom_Fichier = "C:\Chemin\NomFichier.ext"
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
With oBjMail
If ActiveCell.Value = "" Then MsgBox "Merci de sélectionner une ligne dans le tableau": Exit Sub
.To = Cells(ActiveCell.Row, 19).Value 'indique l adresse du destinataire = contenu de la colonne n°18 de la ligne active
.Subject = Cells(ActiveCell.Row, 3).Value & ", " & Cells(ActiveCell.Row, 22).Value & " : commande" ' l'objet du mail
'.Body = Range("C2").Value & vbCrLf ' Le corps de texte. Si on veut renvoyer à une cellule précise, on peut utiliser la fonction suivante après "Body =": Range("C2").Value & vbCrLf. Le code vbCrLf (ou le code "& Chr(13)") renvoie à la ligne (une sorte de "enter")
.Body = "Commande numéro " & Cells(ActiveCell.Row, 1).Value & " datée du " & Cells(ActiveCell.Row, 2).Value & " concernant le chantier : " & Cells(ActiveCell.Row, 4).Value _
& vbCrLf _
& Sheets("Cde@").[A16] & vbCrLf _
& Cells(ActiveCell.Row, 25).Value & " " & Cells(ActiveCell.Row, 26).Value & vbCrLf _


'.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
.Display
'.Send 'Ici on peut supprimer pour l'envoyer sans vérification: il suffit de supprimer le " ' " devant la fonction ".send" et le mail partira sans vérification
End With
'ObjOutlook.Quit => cette fontion sert si on veut quitter automatiquement outlook après l'envoi du mail (il suffit ici de supprimer le caractère ' placé avant la fonction
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub


' Sous-traitant
Sub Envoyer_Mail_CdeST()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
'Exemple pour envoyer un classeur en pièce jointe
'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
'Ou bien entrer le path et nom du fichier autrement
Nom_Fichier = "C:\Chemin\NomFichier.ext"
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
'ou encore
'et pour attacher un fichier en spécifiant le chemin dans une cellule:
'CheminFichier1$ = Sheets("Cde@").Range("A16")
'.Attachments.Add CheminFichier1$
'idem mais avec plusieurs cellules:
'CheminFichier1$ = Sheets("Feuil1").Range("A16")
'CheminFichier2$ = Sheets("Feuil1").Range("A17")
'CheminFichier3$ = Sheets("Feuil1").Range("A18")
'CheminFichier4$ = Sheets("Feuil1").Range("A19")
'If CheminFichier1$ > "" Then .Attachments.Add CheminFichier1$
'If CheminFichier2$ > "" Then .Attachments.Add CheminFichier2$
'If CheminFichier3$ > "" Then .Attachments.Add CheminFichier3$
'If CheminFichier4$ > "" Then .Attachments.Add CheminFichier4$

'et si on veut prévenir qu'il y a une mauvaise adresse ou qu'un fichier n'est pas valide:
'si on a plusieurs fichiers:
'For i = 1 To 5
'R$ = Choose(i, "A16", "A17", "A18", "A19", "A20")
'F$ = Sheets("Cde@").Range(R$)
'If F$ > "" Then
' If Dir(F$) <> "" Then .Attachments.Add F$ Else MsgBox "Ce chemin\fichier est incorrect ou inexistant !?" & vbLf & F$, vbCritical, ""
'End If
'Next
'____________________________________________________
With oBjMail
If ActiveCell.Value = "" Then MsgBox "Merci de sélectionner une ligne dans le tableau": Exit Sub
.To = Cells(ActiveCell.Row, 19).Value 'indique l adresse du destinataire = contenu de la colonne n°18 de la ligne active
.Subject = Cells(ActiveCell.Row, 3).Value & ", " & Cells(ActiveCell.Row, 22).Value & " : commande" ' l'objet du mail
'.Body = Range("C2").Value & vbCrLf ' Le corps de texte. Si on veut renvoyer à une cellule précise, on peut utiliser la fonction suivante après "Body =": Range("C2").Value & vbCrLf. Le code vbCrLf (ou le code "& Chr(13)") renvoie à la ligne (une sorte de "enter")
.Body = "Commande numéro " & Cells(ActiveCell.Row, 1).Value & " datée du " & Cells(ActiveCell.Row, 2).Value & " concernant le chantier : " & Cells(ActiveCell.Row, 4).Value _
& vbCrLf _
& Sheets("Cde@").[A7] & vbCrLf _
& Sheets("Cde@").[A8] & vbCrLf _
& Sheets("Cde@").[A9] & vbCrLf _
& Sheets("Cde@").[A10] & vbCrLf _
& Sheets("Cde@").[A11] & vbCrLf _
& Sheets("Cde@").[A12] & vbCrLf _
& Cells(ActiveCell.Row, 25).Value & " " & Cells(ActiveCell.Row, 26).Value & vbCrLf _

For i = 1 To 5
R$ = Choose(i, "A16", "A17", "A18", "A19", "A20")
F$ = Sheets("Cde@").Range(R$)
If F$ > "" Then
If Dir(F$) <> "" Then .Attachments.Add F$ Else MsgBox "Ce chemin\fichier est incorrect ou inexistant !? Merci de vérifier le chemin spécifié dans les cellules A16 à A20 de la feuille Cde" & vbLf & F$, vbCritical, ""
End If
Next
.Display
'.Send 'Ici on peut supprimer pour l'envoyer sans vérification: il suffit de supprimer le " ' " devant la fonction ".send" et le mail partira sans vérification
End With
'ObjOutlook.Quit => cette fontion sert si on veut quitter automatiquement outlook après l'envoi du mail (il suffit ici de supprimer le caractère ' placé avant la fonction
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

 

[Roland_M]

re

j'ai oublié une chose toute bête ! j'ai pas modifié sur le bouton l'appel de la macro !
sur ta feuille il faut que tu fasses clic droit sur le bouton vert et faire "affecter une macro"
et tu choisis la macro "BoutonEnvoiMail"

 

[cgpa]

Roland, c'est génial: ça marche. Et je comprends maintenant la raison de la ligne "If MsgBox...". Un tout grand merci pour ton aide: je vais pouvoir adapter le code au fichier de base et simplifier la vie des utilisateurs du fichier. Je te souhaite une excellente journée!

 

[Roland_M]

re

le "if msgbox.." c'est simplement la question(confirmation) qui t'es posée juste avant l'envoi !