VBA Outlook Fermé

Question

Bonjour, 

Je cherche à faire un bouton (une macro avec raccourci dans le ruban outlook, ça a l'air parfait),
pour traiter le mail sélectionné:

• Créer un dossier sur le bureau nommé *nom de l'expéditeur* *objet du mail*
• Copier les pièces jointes du mail dans ce dossier
• Copier le mail dans le dossier

•Ouvrir un classeur Excel (dont le chemin est connu),
•en A1, *Nom de l'expéditeur*.

Pour l'instant, j'ai réussi à insérer le bouton dans le ruban, et j'en suis la:

Sub macro1()

End sub

Autrement dit je suis en bonne voie, mais si vous aviez des idées pour compléter, ce serait vraiment sympa.
Je connais un peu le VBA sur Excel, mais la, j'ai l'impression d'avoir beaucoup de variables à déclarer et je ne vois pas trop comment, par quoi commencer...

Merci beaucoup!


Configuration: Windows / Firefox 71.0

Anthelm · Answer

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

VBA Outlook

1 réponse

Discussions similaires