VBA Outlook
Fermé
Anthelm
Messages postés
198
Date d'inscription
lundi 15 octobre 2018
Statut
Membre
Dernière intervention
2 mars 2024
-
Modifié le 12 déc. 2019 à 23:13
Anthelm Messages postés 198 Date d'inscription lundi 15 octobre 2018 Statut Membre Dernière intervention 2 mars 2024 - 14 déc. 2019 à 17:06
Anthelm Messages postés 198 Date d'inscription lundi 15 octobre 2018 Statut Membre Dernière intervention 2 mars 2024 - 14 déc. 2019 à 17:06
A voir également:
- VBA Outlook
- Nouveau outlook - Guide
- Compte outlook gratuit - Guide
- Outlook mot de passe oublié - Guide
- Réponse automatique outlook - Guide
- Synchroniser agenda google et outlook - Guide
1 réponse
Anthelm
Messages postés
198
Date d'inscription
lundi 15 octobre 2018
Statut
Membre
Dernière intervention
2 mars 2024
1
14 déc. 2019 à 17:06
14 déc. 2019 à 17:06
Avec des bouts de codes trouvés sur internet et un peu de bricolage...
C'est pas encore au point du tout, je ne trouve pas moyen d'extraire les pièces jointes dans un dossier situé sur le bureau.
If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
'Ici on construit le nom du fichier qui sera créé
'Objet du mail + Nom de l'expéditeur
NomExport = objCurrentMessage.Subject & " " & objCurrentMessage.SenderName
'Ici on supprime les caractères spéciaux de NomExport:
nomexportcorrige = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
'Ici on défini le répertoire "de base"
repertoire = "D:\Profils_RDS\user\Bureau\TEST\"
'Ici on supprime les caractères non autorisé dans les noms de fichiers
Pathnomexport = repertoire & nomexportcorrige & "\" & nomexportcorrige & ".msg"
'Ici on crée le répertoire
MkDir ("D:\Profils_RDS\user\Bureau\TEST\" & nomexportcorrige)
objCurrentMessage.SaveAs Pathnomexport
End Sub
Ca c'est juste pour lancer la macro sur le mail séléctioné et non pas celui dans l'explorer:
Sub LanceSurSelection()
Dim MonOutlook As Outlook.Application
Dim LeMail As Object
Dim LesMails As Outlook.Selection
Set MonOutlook = Outlook.Application
Set LesMails = MonOutlook.ActiveExplorer.Selection
For Each LeMail In LesMails
sav_mail_as_msg LeMail
Next LeMail
Set LesMails = Nothing
MsgBox "Fin de traitement"
End Sub
C'est pas encore au point du tout, je ne trouve pas moyen d'extraire les pièces jointes dans un dossier situé sur le bureau.
If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
'Ici on construit le nom du fichier qui sera créé
'Objet du mail + Nom de l'expéditeur
NomExport = objCurrentMessage.Subject & " " & objCurrentMessage.SenderName
'Ici on supprime les caractères spéciaux de NomExport:
nomexportcorrige = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
'Ici on défini le répertoire "de base"
repertoire = "D:\Profils_RDS\user\Bureau\TEST\"
'Ici on supprime les caractères non autorisé dans les noms de fichiers
Pathnomexport = repertoire & nomexportcorrige & "\" & nomexportcorrige & ".msg"
'Ici on crée le répertoire
MkDir ("D:\Profils_RDS\user\Bureau\TEST\" & nomexportcorrige)
objCurrentMessage.SaveAs Pathnomexport
End Sub
Ca c'est juste pour lancer la macro sur le mail séléctioné et non pas celui dans l'explorer:
Sub LanceSurSelection()
Dim MonOutlook As Outlook.Application
Dim LeMail As Object
Dim LesMails As Outlook.Selection
Set MonOutlook = Outlook.Application
Set LesMails = MonOutlook.ActiveExplorer.Selection
For Each LeMail In LesMails
sav_mail_as_msg LeMail
Next LeMail
Set LesMails = Nothing
MsgBox "Fin de traitement"
End Sub
