I want to write a macro for outlook that lets me do the following:

1. Move a selected email to a specific folder (with selection box)

2. create an appointment in a non default calendar with the same subject as the email

3. Put a link into the appointment body that links to the email (similar to the option that Outlook gives you when you drag an email onto the calender: "Copy Here as Appointment with Shortcut")

Unfortunately step 3 (creating the link to the email) can not be recreated unsing QuickSteps. Therefore I have to solve this with VBA.

Here is the code I came up with so far:


 

Sub Mail2Appt()

    ' Moves each of the selected items on the screen to a selected folder.
    Dim olApp As New Outlook.Application
    Dim olExp As Outlook.Explorer
    Dim olSel As Outlook.Selection
    Dim olNameSpace As Outlook.NameSpace
    Dim olDestFolder As Outlook.Folder
    Dim intItem As Integer

    Set olExp = olApp.ActiveExplorer
    Set olSel = olExp.Selection
    Set olNameSpace = olApp.GetNamespace("MAPI")
    
    '1. Handle the movement of the selected emails
    'Display form to pick destination Folder
    Set olDestFolder = olNameSpace.PickFolder
    
    'To do: folder type validation
    If TypeName(olDestFolder) <> "Nothing" Then
        'Debug.Print vbCr & " olDestFolder: " & olDestFolder
    Else
        'Debug.Print vbCr & "Cancel"
        Exit Sub
    End If
    
    'Move selection to new folder
    For intItem = 1 To olSel.Count
        olSel.Item(intItem).Move olDestFolder
    Next intItem
    
    
    '2. Create appointment in To-Do-Calendar
    Dim myCalItem As Outlook.AppointmentItem
    Dim myToDoCalendar As Outlook.Folder
    
    'get non-default calender
    Set myToDoCalendar = Session.GetDefaultFolder(olFolderCalendar).Parent.Folders("Aufgaben-Kalender")
    
    For intItem = 1 To olSel.Count
        Set myCalItem = myToDoCalendar.Items.Add(olAppointmentItem)
        
        myCalItem.Subject = olSel.Item(intItem).Subject
        myCalItem.Location = "Office"
        myCalItem.Duration = 30
        
        '3. Place link to email in appointment body
        myCalItem.Body = "Hello World"  'Link to Email must go here
        
        myCalItem.Display
    Next intItem
  
End Sub

It would be great if somebody could push me in the right direction.

Cheers,

Sascha