Enregistrement pdf dans un dossier specifique
Bonjour
je souhaiterais dans le code ci dessous permettant d'envoyer le fichier en pdf par mail ( qui fonctionne très bien lui) rajouter une commande pour réaliser en même temps que l'envoi sur le même bouton, l'enregistrement de ce PDF dans un dossier spécifique.
Bien sur pour simplifier la chose, je souhaite que mon fichier porte le nom de la feuille active suivi de la date et heure de création ( car on en créer plusieurs par jours) et qu'il se range dans un dossier mensuel. Toutes les feuilles du mois de mai 20 par exemple dans le dossier "MAI 2020".
a savoir si je dois créer les dossiers mensuels avant ou bien si le code peut le faire seul en fonction du mois actuel?
merci d'avance pour votre aide, je galère avec ça depuis plusieurs jours.
voici mon code
Sub mail()
'Fonctionne sous excel 2000-2016
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = "Mise a jour du " & ActiveSheet.Name & " du " & Date
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = "test@test.com"
.CC = "" 'mettre adresse entre les guillemets si besoin
.BCC = ""
.Subject = "Mise a jour du " & ActiveSheet.Name & " du " & Date & " à " time
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour," & Chr(13) & "Veuillez trouver en pièce jointe la mise à jour du" & ActiveSheet.Name & " du " & Date & " à " & Time & Chr(13) & " cordialement."
.Display 'ou alors utiliser
'.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour
je vous relance pour mon code qui me bloque
Merci a vous
Cdlt
Bonjour
je souhaiterais dans le code ci dessous permettant d'envoyer le fichier en pdf par mail ( qui fonctionne très bien lui) rajouter une commande pour réaliser en même temps que l'envoi sur le même bouton, l'enregistrement de ce PDF dans un dossier spécifique.
Bien sur pour simplifier la chose, je souhaite que mon fichier porte le nom de la feuille active suivi de la date et heure de création ( car on en créer plusieurs par jours) et qu'il se range dans un dossier mensuel. Toutes les feuilles du mois de mai 20 par exemple dans le dossier "MAI 2020".
a savoir si je dois créer les dossiers mensuels avant ou bien si le code peut le faire seul en fonction du mois actuel?
merci d'avance pour votre aide, je galère avec ça depuis plusieurs jours.
voici mon code
Sub mail()
'Fonctionne sous excel 2000-2016
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = "Mise a jour du " & ActiveSheet.Name & " du " & Date
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = "test@test.com"
.CC = "" 'mettre adresse entre les guillemets si besoin
.BCC = ""
.Subject = "Mise a jour du " & ActiveSheet.Name & " du " & Date & " à " time
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour," & Chr(13) & "Veuillez trouver en pièce jointe la mise à jour du" & ActiveSheet.Name & " du " & Date & " à " & Time & Chr(13) & " cordialement."
.Display 'ou alors utiliser
'.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour,
Merci de mettre tes codes entre balises [ CODE] et [ /CODE] sans espace après le [
@+
Bonjour Phil74950, le forum,
En retour l'ajout de la macro ExpPdf sur le fichier.
Voir notes sur la 1ière feuille.
Bons tests, bonne continuation.