Salut le forum

J'ai un code que j'essai d'envoyer un mail avec fichier joint.
Le fichier à joindre se trouve sur le bureau et plus précisement dans le dossier VISA (le plus recent).
N.B:il faut noter que sur mon bureau, il y'a des dossiers VISA suivi de l'année en cours (VISA 2013, VISA 2014...).
Donc je souhaite que le fichier à joindre soit celui le plus recent du dossier "VISA" de l'année en cours.
Merci d'apprécier le code ci-dessous et voir comment réaliser mon besoin.
Aussi, je précise que le nom du fichier est la valeur de la cellule PARAMETRE!R1
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Sub Mail_Visa()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim texte As String
Dim Dossier As String, Exercice As String
Dossier = "C:\Username\Desktop"
 
Exercice = Dossier & "\VISA " & Format(Date, "yyyy")
If Dir(Exercice, vbDirectory) = "" Then MkDir Exercice
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
texte = texte & "Bonjour à tous" & vbCrLf & vbCrLf
texte = texte & "Merci de trouver en fichier joint les demandes de dépassements exprimées par nos clients" & vbCrLf & vbCrLf
texte = texte & "Bonne réception" & vbCrLf & vbCrLf
 
On Error Resume Next
With OutMail
.To = Sheets("parametre").Range("23").Value
.Cc = Sheets("parametre").Range("24").Value
.BCC = ""
.Subject = "Demande de visa"
.Body = texte
' You can add other files by uncommenting the following line.
.Attachments.Add Exercice & "\" & Sheets("PARAMETRE").Range("R1")
 
.Send
End With
On Error GoTo 0
' Effacer les variable objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sub Mail_Visa_DR()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim texte As String
Dim Dossier As String, Exercice As String
Dossier = "C:\Username\Desktop"
 
Exercice = Dossier & "\VISA " & Format(Date, "yyyy")
If Dir(Exercice, vbDirectory) = "" Then MkDir Exercice
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
texte = texte & "Bonjour à tous" & vbCrLf & vbCrLf
texte = texte & "Merci de trouver en fichier joint les demandes de dépassements exprimées par nos clients" & vbCrLf & vbCrLf
texte = texte & "Bonne réception" & vbCrLf & vbCrLf
 
On Error Resume Next
With OutMail
.To = Sheets("parametre").Range("26").Value
.Cc = Sheets("parametre").Range("24").Value
.BCC = ""
.Subject = "Demande de visa"
.Body = texte
' You can add other files by uncommenting the following line.
.Attachments.Add Filename:=Exercice & "\" & Sheets("PARAMETRE").Range("R1")
 
.Send
End With
On Error GoTo 0
' Effacer les variable objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub