bonjour
je bloque sur le fait de pouvoir faire partir tous les jours un mail avec la sauvegarde daté du jour.
j’ai réussi a faire une macro pour la sauvegarde automatique avec date et l’envoi du mail…
Par contre je ne trouve pas comment faire pour que la pièce jointe soit la dernière généré dans mon dossier de sauvegarde.
voici mes macros.
Private Sub Workbook_Deactivate()
ChDrive « C:\Users\OLIVIER\Documents\rapport »
ChDir « C:\Users\OLIVIER\Documents\rapport »
SaveFileName = CurDir & « » & « rapport journalier C.A.B » & « _ » & Format(Date, « dd-mm-yyyy ») & « .xlsm »
ActiveWorkbook.SaveAs Filename:=SaveFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
et la deuxième :
Private Sub CommandButton1_Click()
Dim destinataire, sujet, fichierjoint As String
destinataire = « moi@ »
sujet = « essai! »
body = « Rapport Journalier C.A.B ? »
fichierjoint = « C:\Users\OLIVIER\Documents\rapport\rapport journalier C.A.B_20-06-2020.xlsm »
strcommand = « C:\Program Files\Mozilla Thunderbird\thunderbird »
strcommand = strcommand & " -compose " & « to=’ » & destinataire & « ’ »
strcommand = strcommand & « , » & « subject= » & sujet & « , »
strcommand = strcommand & « body= » & body
strcommand = strcommand & « , » & « attachment=file:/// » & fichierjoint
MsgBox strcommand
Call Shell(strcommand, vbNormalFocus)
End Sub
merci de votre aide.
olivier
FFO
Juin 21, 2020, 8:34
2
Bonjour
Dans ta 2° macro qui envoie le mail avec la pièce jointe rajoutes ces lignes de code :
Chemin = " C:\Users\OLIVIER\Documents\rapport"
Fichier = Dir(Chemin & « *.xlsm »)
dateretenue = « 01-01-1900 »
Do While Fichier <> « »
dateenregistrement = Right(Split(Fichier, « .xlsm »)(0), 10)
If IsDate(dateenregistrement) Then
If CDate(dateenregistrement) > CDate(dateretenue) Then
dateretenue = dateenregistrement
derfichier = Fichier
End If
End If
Fichier = Dir
Loop
fichierjoint = « C:\Users\OLIVIER\Documents\rapport" & derfichier
Ce qui donne ce code global :
Private Sub CommandButton1_Click()
Dim destinataire, sujet, fichierjoint As String
Chemin = " C:\Users\OLIVIER\Documents\rapport"
Fichier = Dir(Chemin & « *.xlsm »)
dateretenue = « 01-01-1900 »
Do While Fichier <> « »
dateenregistrement = Right(Split(Fichier, « .xlsm »)(0), 10)
If IsDate(dateenregistrement) Then
If CDate(dateenregistrement) > CDate(dateretenue) Then
dateretenue = dateenregistrement
derfichier = Fichier
End If
End If
Fichier = Dir
Loop
destinataire = « moi@ »
sujet = « essai! »
body = derfichier
fichierjoint = « C:\Users\OLIVIER\Documents\rapport" & derfichier
strcommand = « C:\Program Files\Mozilla Thunderbird\thunderbird »
strcommand = strcommand & " -compose " & « to=’ » & destinataire & « ’ »
strcommand = strcommand & « , » & « subject= » & sujet & « , »
strcommand = strcommand & « body= » & body
strcommand = strcommand & « , » & « attachment=file:/// » & fichierjoint
MsgBox strcommand
Call Shell(strcommand, vbNormalFocus)
End Sub
Attention l’enregistrement des fichiers doit toujours être sous cette forme :
SaveFileName = CurDir & « » & « rapport journalier C.A.B » & « _ » & Format(Date, « dd-mm-yyyy ») & « .xlsm »
avec la date en tout fin de nom avant le .xlsm : Format(Date, « dd-mm-yyyy ») & « .xlsm »
A essayer et me dire
Merci a toi FFO
Il y a erreur de syntaxe et fin inattendue .
je te joint le tableau excel pour que tu regarde ceci .
Merci de ton aide car je ne suis pas doué en la matiere.
olivier
rapport journalier C.A.B_21-06-2020.xlsm (24,4 Ko)
FFO
Juin 21, 2020, 9:16
4
Il faut se méfier des guillemets repris de notre fil de discussion
Il faut les retaper au clavier accolé à la donnée et lorsqu’il y en a 2 l’un après l’autre les retaper sans espace entre
Ton fichier corrigé ainsi
Il se porte beaucoup mieux
Je ne peux pas le tester n’ayant pas Mozilla Thunderbird
Je te laisse la main pour cela et me dire
RAPPORT JOURNALIER 2.xlsm (21,2 Ko)
Merci FFO
alors c’est mieux par contre il ne va pas me chercher le fichier désigné dans le répertoire mais le répertoire lui même…
est ce qu’il faut que je change la date que tu as inséré dans ton code « 01-01-1900 »
je te remercie pour ton aide .
FFO
Juin 21, 2020, 3:48
6
Petites erreurs dans le code
Cette ligne :
Chemin = " C:\Users\OLIVIER\Documents\rapport"
Il faut mettre comme ceci :
Chemin = " C:\Users\OLIVIER\Documents\rapport"
manque l’antishlas en bout
Idem ici :
fichierjoint = « C:\Users\OLIVIER\Documents\rapport » & derfichier
L’antishlas après rapport ainsi
fichierjoint = « C:\Users\OLIVIER\Documents\rapport » & derfichier
ci-joint ton fichier corrigé ainsi
Réessaies avec et dis moi
RAPPORT JOURNALIER 2.xlsm (21,3 Ko)
super merci cela fonctionne. Par contre sans vouloir abusé de ton talent est ce que tu peut me faire exécuté cela a la fermeture du classeur.
Merci encore pour ton aide précieuse
FFO
Juin 21, 2020, 4:43
8
Dans ce fichier j’ai reporté toute ta procédure d’envoi du mail dans le Thisworkbook procédure évènementielle avant fermeture « Private Sub Workbook_BeforeClose(Cancel As Boolean) »
Reste à savoir si tout son déroulement est à garder (un message est donné en fin doit il être conservé)
A toi de voir
Si tu peux sans t’obliger et si tu es satisfait une petite validation sera la bienvenue
Merci
RAPPORT JOURNALIER 2.xlsm (21,1 Ko)
super FFO merci beaucoup juste une petite choses j’ai un apostrophe ’ qui apparait avant et aprés mon adresse mail dans thunderbird. comment faire pour les enlevés.
Merci beaucoup
FFO
Juin 21, 2020, 5:56
10
Dans ton code que tu m’as fourni au niveau de l’instruction de l’adresse mail je n’ai que cela :
destinataire = « moi@ »
Je suppose que tu as du remplacer par une véritable adresse
Comment procèdes tu
Il faut m’en dire plus
Merci
j’ai tout simplement tapé mon adresse mail ente les " ".
Merci de ton aide
FFO
Juin 21, 2020, 6:03
12
Peux tu me montrer un exemple (l ensemble de la ligne de code)
Private Sub CommandButton1_Click()
Dim destinataire, sujet, fichierjoint As String
Chemin = "C:\Users\OLIVIER\Documents\rapport"
Fichier = Dir(Chemin & « *.xlsm »)
dateretenue = « 01-01-1900 »
Do While Fichier <> « »
dateenregistrement = Right(Split(Fichier, « .xlsm »)(0), 10)
If IsDate(dateenregistrement) Then
If CDate(dateenregistrement) > CDate(dateretenue) Then
dateretenue = dateenregistrement
derfichier = Fichier
End If
End If
Fichier = Dir
Loop
destinataire = « dricilo.ob@gmail.com »
sujet = « essai! »
body = derfichier
fichierjoint = "C:\Users\OLIVIER\Documents\rapport" & derfichier
strcommand = « C:\Program Files\Mozilla Thunderbird\thunderbird »
strcommand = strcommand & " -compose " & « to=’ » & destinataire & « ’ »
strcommand = strcommand & « , » & « subject= » & sujet & « , »
strcommand = strcommand & « body= » & body
strcommand = strcommand & « , » & « attachment=file:/// » & fichierjoint
MsgBox strcommand
Call Shell(strcommand, vbNormalFocus)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim destinataire, sujet, fichierjoint As String
Chemin = "C:\Users\OLIVIER\Documents\rapport"
Fichier = Dir(Chemin & « *.xlsm »)
dateretenue = « 01-01-1900 »
Do While Fichier <> « »
dateenregistrement = Right(Split(Fichier, « .xlsm »)(0), 10)
If IsDate(dateenregistrement) Then
If CDate(dateenregistrement) > CDate(dateretenue) Then
dateretenue = dateenregistrement
derfichier = Fichier
End If
End If
Fichier = Dir
Loop
destinataire = « dricilo.ob@gmail.com »
sujet = « essai! »
body = derfichier
fichierjoint = "C:\Users\OLIVIER\Documents\rapport" & derfichier
strcommand = « C:\Program Files\Mozilla Thunderbird\thunderbird »
strcommand = strcommand & " -compose " & « to=’ » & destinataire & « ’ »
strcommand = strcommand & « , » & « subject= » & sujet & « , »
strcommand = strcommand & « body= » & body
strcommand = strcommand & « , » & « attachment=file:/// » & fichierjoint
MsgBox strcommand
Call Shell(strcommand, vbNormalFocus)
End Sub
FFO
Juin 21, 2020, 6:09
14
Je viens de trouver l origine
Cette ligne qui récupère ton adresse rajoute les petites côtes :
strcommand = strcommand & " -compose " & « to=’ » & destinataire & « ’ »
Mets la comme cela :
strcommand = strcommand & " -compose " & « to= » & destinataire
Attention si tu récupères cette ligne de retaper au clavier les guillemets accolée aux données
Essaies et dis moi
super ça Marche du tonnerre de dieu . … je te remercie beaucoup et porte toi bien …
GOOD JOB
FFO
Juin 21, 2020, 6:31
16
Merci du retour
Amuses toi bien avec ton outil automatique
Au plaisir
system
A fermé ce sujet ()
Juillet 21, 2020, 6:31
17
Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.