Bonjour à toutes et tous,
Je souhaiterais faire une macro qui:
1) récupère le dernier ficher pdf modifié dans un dossier.
2) Puis qui crée un mail et insére le pdf récupérer ci dessus
3) Puis l'envoi automatiquement à une liste de destinataire qui ne change pas une fois par semaine. Par exemple le vendredi à 19h00.
Pour le moment ,j'arrive à crée le mail , la pièce jointe j'arrive à mettre la dernière modifié manuellement, mais j'arrive pas crée quelques chose qui permettrai de sélectionner le dernier fichier modifié et de mettre le bon chemin d'accès pour la pièce jointe.
Voila le début de code :
Sub Ouverture_et_envoi_mail_Outlook_Roulement()
Dim OL As Object
Dim OLmail As Object
On Error Resume Next
Set OLk_Appli = GetObject("Outlook.Application")
If OLk_Appli Is Nothing Then
'mettre le bon chemin outlook
OLk_OK = Shell("C:\Program Files (x86)\Microsoft Office\Office16\outlook.exe", 1)
End If
Set OL = CreateObject("Outlook.Application")
Set OLmail = OL.CreateItem(0)
With OLmail
.To = "XX" 'mettre la bonne adresse mail yoann c'est pour le test
.Subject = "Roulement PC SAPHYRS "
.Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci joint le roulement du PC SAPHYRS. " _
& vbCrLf & " " _
& vbCrLf & " " & vbCrLf & vbCrLf _
& "Cordialement," & vbCrLf & vbCrLf & "Le PC SAPHYRS"
.Attachments.Add "Chemin du fichier à récuperer"
'.DeferredDeliveryTime = ("21/02/2023 10:43:00")
.DeferredDeliveryTime = (prochainvendredi & " 11:30:00")
'.Display
.Send
End With
'MsgBox "Votre mail a été envoyé.", vbInformation + vbOKOnly, "Confirmation envoyée"
Set OLmail = Nothing
Set OL = Nothing
Set OLk_Appli = Nothing
End Sub
Function prochainvendredi()
While WeekdayName(Weekday(Now + n, vbMonday)) <> WeekdayName(Weekday(#10/29/2021#, vbMonday))
n = n + 1
Wend
prochainvendredi = Format(Now() + n, "dd/mm/yy")
End Function
Merci d'avance
Yuee
Je souhaiterais faire une macro qui:
1) récupère le dernier ficher pdf modifié dans un dossier.
2) Puis qui crée un mail et insére le pdf récupérer ci dessus
3) Puis l'envoi automatiquement à une liste de destinataire qui ne change pas une fois par semaine. Par exemple le vendredi à 19h00.
Pour le moment ,j'arrive à crée le mail , la pièce jointe j'arrive à mettre la dernière modifié manuellement, mais j'arrive pas crée quelques chose qui permettrai de sélectionner le dernier fichier modifié et de mettre le bon chemin d'accès pour la pièce jointe.
Voila le début de code :
Sub Ouverture_et_envoi_mail_Outlook_Roulement()
Dim OL As Object
Dim OLmail As Object
On Error Resume Next
Set OLk_Appli = GetObject("Outlook.Application")
If OLk_Appli Is Nothing Then
'mettre le bon chemin outlook
OLk_OK = Shell("C:\Program Files (x86)\Microsoft Office\Office16\outlook.exe", 1)
End If
Set OL = CreateObject("Outlook.Application")
Set OLmail = OL.CreateItem(0)
With OLmail
.To = "XX" 'mettre la bonne adresse mail yoann c'est pour le test
.Subject = "Roulement PC SAPHYRS "
.Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci joint le roulement du PC SAPHYRS. " _
& vbCrLf & " " _
& vbCrLf & " " & vbCrLf & vbCrLf _
& "Cordialement," & vbCrLf & vbCrLf & "Le PC SAPHYRS"
.Attachments.Add "Chemin du fichier à récuperer"
'.DeferredDeliveryTime = ("21/02/2023 10:43:00")
.DeferredDeliveryTime = (prochainvendredi & " 11:30:00")
'.Display
.Send
End With
'MsgBox "Votre mail a été envoyé.", vbInformation + vbOKOnly, "Confirmation envoyée"
Set OLmail = Nothing
Set OL = Nothing
Set OLk_Appli = Nothing
End Sub
Function prochainvendredi()
While WeekdayName(Weekday(Now + n, vbMonday)) <> WeekdayName(Weekday(#10/29/2021#, vbMonday))
n = n + 1
Wend
prochainvendredi = Format(Now() + n, "dd/mm/yy")
End Function
Merci d'avance
Yuee
