VBA - envoi mail - Pièce jointe - chemin qui va changer de nom

Bonjour,

J'aimerais joindre à mon mail générer par code vba une pièce jointe.

Sur ma clé usb les pièces jointes se trouvent dans des dossiers qui changent de nom au fil des jours, mois et années. L'exemple de l'arborescence est donné ci-dessous.

Cette pièce jointe sera récupérée sur une clé usb dont le chemin est constitué d'une partie toujours identique et une autre partie dont les dossiers années mois etc. changeront automatiquement (voir exemple ci dessous). Je souhaiterais intégré cet automatisme dans le chemin indiqué dans la fonction de pièce jointe suivante :

.Attachments.Add

Exemple :

G:\chemintoujoursidentique\année\moissur2chiffres - moisenlettresmajuscules\jour2chiffremois2chiffresannée4chiffres\zz tom tam jour2chiffremois2chiffresannée4chiffres - 0230Z.txt

G:\chemintoujoursidentique\2024\06 - JUIN\22062024\zz tom tam 22062024 - 0230Z.txt

Je ne sais donc pas comment exprimé cela dans "nomfichier"

Je vous remercie par avance pour les idées que vous pourrez m'apporter.

Sub Envoi_SPA()
' Envoi_SPA_ Macro
Dim OutlookApp As Object
Dim MailItem As Object
Dim SigString As String
Dim Signature As String
Dim nomfichier As String

nomfichier = 

' Vérifier si Outlook est ouvert
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0

' Si Outlook n'est pas ouvert, ouvrir une nouvelle instance
'If OutlookApp Is Nothing Then
Set OutlookApp = CreateObject("Outlook.Application")
'End If

' Créer un nouvel e-mail
Set MailItem = OutlookApp.CreateItem(0)

' Remplir les détails de l'e-mail

With MailItem
.Display
.To = Range("B4")
.Subject = Range("B8")
.HTMLBody = RangetoHTML(Range("B10:C20"))

' Ajouter des pièces jointes si nécessaire
.Attachments.Add "G:\chemin\& nomfichier"

' Afficher l'e-mail
End With

 ' Libérer les objets
Set MailItem = Nothing
Set OutlookApp = Nothing
ActiveWorkbook.Save
Application.WindowState = xlNormal
ActiveWindow.SmallScroll Down:=0
ActiveWorkbook.Save

End Sub

Function RangetoHTML(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso         As Object
Dim ts          As Object
Dim TempFile    As String
Dim TempWB      As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0

End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)

End With

'Read all data from the htm file into RangetoHTML

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                  "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False   

'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

Bonjour guibs,

Une proposition basée sur la date du jour (sinon il suffira de remplacer Date par la variable adéquate) :

.Attachments.Add = "G:\chemintoujoursidentique\" & Format(Date, "yyyy") & "\" & UCase(Format(Date, "mm - mmmm")) & "\" & Format(Date, "ddmmyyyy") & "\zz tom tam " & Format(Date, "ddmmyyyy") & " - 0230Z.txt"

Cdlt,

Cylfo

Bonjour Cylfo,

Merci pour ton retour. Ca fonctionne parfaitement je l'ai mis dans une variable

nomfichier = "G:\chemintoujoursidentique\" & Format(Date, "yyyy") & "\" & UCase(Format(Date, "mm - mmmm")) & "\" & Format(Date, "ddmmyyyy") & "\zz tom tam " & Format(Date, "ddmmyyyy") & " - 0230Z.txt"

et ensuite appeler cette variable

.Attachments.Add nomfichier

Un grand merci à toi pour ton aide c'est super !