Créer un(des) rendez-vous/ demande(s) de réunion à partir d'email(s)

Télécharger le projet
Commenter

Description

Permet de créer un rendez-vous/une demande de réunion à partir d'un email. La macro fonctionne également sur une sélection d'emails, sélection faite depuis la fenetre principale d'outlook.
L'ensemble des informations de l'email est copié dans le rendez-vous: le sujet du rendez-vous correspond a celui de l'email, le corps du mail est intégré dans le corps du rendez-vous, les destinataires en copie dans l'email sont transformés en participants (permet de créer et d'envoyer une demande de réunion), les pièces jointes sont également ajoutées. Vous aurez tout sous la main, vous évitant de rechercher l'email à partir duquel le rendez-vous a été créé.
Lors d'une sélection multiple d'email depuis la fenetre principale d'Outlook, les heures de début/de fin sont automatiquement ajustées afin que les rendez-vous créés ne se chevauchent pas.
Merci de lire les recommandations de la conclusion afin d'utiliser au mieux cette macro.

Source / Exemple : 


'Le script vbs doit etre copié dans un éditeur (bloc-note par exemple) et sauvegardé sous "NomDuScript.VBS"

'Début du script

Set fso =CreateObject("WScript.Shell")
wscript.sleep 200
fso.SendKeys ("a")
wscript.sleep 200
fso.SendKeys ("{tab}")
wscript.sleep 200
fso.SendKeys ("{tab}")
wscript.sleep 200
fso.SendKeys ("~")

'Fin du script

'Le chemin ou se trouve le script doit etre insere dans la macro qui suit

'_______________________________________________________________

'Début de la macro:

Option Explicit

' Create a New Meeting request from an email
' Written by Michael S. Scherotter (mischero@microsoft.com)
' 1. If the current item is an email, create a new appointment item
' 2. Copy the categories, body, and subject
' 3. Copy the attachments
' 4. Add the sender as a meeting participant
' 5. Add each email recipient as a meeting participant
' 6.    Each To: participant will be required
' 7.    Each CC: or BCC: participant will be optional

'Modification by tomlaptop76
'8. Added the explorer selection (no need to open the item)
'9. Multi items ability
'Original source code visible at
'http://blogs.msdn.com/synergist/attachment/2506592.ashx

Sub NewMeetingRequestFromEmail()
    
Dim app As New Outlook.Application

Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

Dim Item As Object
Dim Email As MailItem
Dim x, y As Integer
Dim RetVal

On Error Resume Next
Set Item = app.ActiveInspector.CurrentItem
Set myOlExp = app.ActiveExplorer
Set myOlSel = myOlExp.Selection

If TypeName(Item) <> "Nothing" Then
    If Item.Class <> olMail Then Exit Sub
    Set Email = Item
    y = 1
Else
    If myOlSel.Count = 0 Then Exit Sub
    If myOlSel.Item(myOlSel.Count).Class <> olMail Then Exit Sub
    y = myOlSel.Count
End If

'Emplacement du script VBS
RetVal = Shell("wscript.exe ""C:\NomDuScript.VBS""", 1) ' vbHide)

For x = 1 To y
    
    If TypeName(Item) = "Nothing" Then
        Set Email = myOlSel.Item(x)
    End If
    
    Dim meetingRequest As AppointmentItem
    
    Set meetingRequest = app.CreateItem(olAppointmentItem)
    
    meetingRequest.Categories = Email.Categories
    meetingRequest.Body = Email.Body
    meetingRequest.Subject = Email.Subject
    meetingRequest.ReminderSet = True
    meetingRequest.Duration = 10
    
    'Evite le chevauchement des rdv
    meetingRequest.Start = meetingRequest.Start + x * (10 / (24 * 60))
         
    Dim attachment As attachment
    
    For Each attachment In Email.Attachments
        CopyAttachment attachment, meetingRequest.Attachments
    Next attachment
    
    Dim recipient As recipient
    
    Set recipient = meetingRequest.Recipients.Add(Email.SenderEmailAddress)
    recipient.Resolve
    
    For Each recipient In Email.Recipients
        RecipientToParticipant recipient, meetingRequest.Recipients
    Next recipient
    
    Dim inspector As inspector
    
    Set inspector = meetingRequest.GetInspector
        
    'inspector.CommandBars.FindControl
    inspector.Display

Next x

End Sub

Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)
    Dim participant As recipient
    
    If LCase(recipient.Address) <> LCase(Session.CurrentUser.Address) Then
        Set participant = participants.Add(recipient.Address)
        Select Case recipient.Type
        Case olBCC:
            participant.Type = olOptional
        Case olCC:
            participant.Type = olOptional
        Case olOriginator:
            participant.Type = olRequired
        Case olTo:
            participant.Type = olRequired
        End Select
        participant.Resolve
    End If

End Sub

Private Sub CopyAttachment(source As attachment, destination As Attachments)
    On Error GoTo HandleError
    
    Dim filename As String
    
    filename = Environ("temp") & "\" & source.filename
    
    source.SaveAsFile (filename)
    
    destination.Add (filename)
    
    Exit Sub
    
HandleError:
    Debug.Print Err.Description
End Sub
'Fin de la macro

Conclusion :


J'ai trouvé un code source sur le blog msdn, je l'ai adapté pour faire de la multi-sélection et pour qu'il fonctionne sans avoir besoin d'ouvrir l'email.

Le script doit etre sauvegardé dans un fichier externe; dans l'exemple ci dessus le script s'appelle "NomDuScript.VBS" et se trouve a la racine du lecteur "C:\"
La macro doit etre sauvegardée dans un module de VB Editor.

Pour utiliser les fichiers du zip tels quel:
Telechargez le fichier zip, dézippez.
Enregistrez "NomDuScript.VBS" dans "C:\"
Dans Outlook appuiez sur Alt+F11 afin d'ouvrir Microsoft VBA, allez dans le menu Fichier, Import.
Importe le fichier Reunion.bas . Sauvegardez et quittez VBA

Pour utiliser la macro, 2 possibilités:
  • Dans Outlook, appuiez sur Alt+F8 pour ouvrir le menu Macro, choisi la macro "NewMeetingRequestFromEmail".
  • Pour affecter une macro a un bouton, il suffit de faire un clic droit sur une barre d'outils, choisir Personnaliser. Dans la liste, choisir Macro, puis la macro en question et de faire un glisser deposer vers une barre d'outils.

J'espère que vous avez toutes les infos nécessaire à l'utilisation de cette macro et qu'elle vous rendra les mêmes services qu'à moi.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (tomlaptop76)