Graham

You are a VBA guru! An old post but it solved my need to put links to Outlook items on the clipboard as hyperlinks, instead of plain text. I've seen the idea of using a temporary mail/Word item and the Word formatting abilities before, but your example is the cleanest I've seen.

I've made some minor changes to your original code: Added lots of comments (I need the help when I come back to code later). Made it capable of handling an Inspector as well as an Explorer item. Added some information about the type of the item being linked to in the hyperlink text. Included "PostItem" in the Type Case.

Public Sub GUID_GetCurrent()

    Dim olTemp As Outlook.MailItem
    Dim olItem As Object
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oLink As Object
    Dim oRng As Object
    Dim ItemTypeName As String
    Dim linkType As String
    Dim linkName As String
    Dim linkID As String


    ' Get an Item from the current Inspector or Explorer Selection


    If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    
        Set olItem = ActiveInspector.CurrentItem
        If olItem Is Nothing Then
            MsgBox "Inspector item not found", vbOKOnly + vbExclamation, "GUID_GetCurrent"
            GoTo lbl_Exit
        End If
        
    ElseIf TypeOf Application.ActiveWindow Is Outlook.Explorer Then
    
        If Application.ActiveExplorer.Selection.Count <> 1 Then
            MsgBox "Must be only one Explorer item selected", vbOKOnly + vbExclamation, "GUID_GetCurrent"
            GoTo lbl_Exit
        End If
        Set olItem = Application.ActiveExplorer.Selection.Item(1)
        
    Else
    
        MsgBox "There must be an open Inspector or an Explorer with one item selected", vbOKOnly + vbExclamation, "GUID_GetCurrent"
        GoTo lbl_Exit


    End If


    ' Get the value to use for the link name/type and the EntryID of the item
    ' based on the type of the item
    
    ItemTypeName = TypeName(olItem)
    Select Case ItemTypeName
    
        Case Is = "MailItem", "TaskItem", "NoteItem", "AppointmentItem", "PostItem"
            linkName = olItem.Subject
            linkID = olItem.EntryID
            linkType = Left(ItemTypeName, Len(ItemTypeName) - Len("Item"))
            If linkType = "Post" Then linkType = "Card"
            
        Case Is = "ContactItem"
            linkName = olItem.FullName
            linkID = olItem.EntryID
            linkType = "Contact"
            
        Case Else
            MsgBox "Invalid item type selected : " + ItemTypeName, vbOKOnly + vbExclamation, "GUID_GetCurrent"
            GoTo lbl_Exit
            
    End Select
    
    ' Create a temporary MailItem
    
    Set olTemp = CreateItem(olMailItem)
    With olTemp
    
        ' Populate the body of the mail with the hyperlink


        .BodyFormat = olFormatHTML
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        ' .Display
        oRng.Text = ""
        Set oLink = wdDoc.Hyperlinks.Add(Anchor:=oRng, _
                                         Address:="outlook:" + linkID, _
                                         SubAddress:="", _
                                         ScreenTip:="", _
                                         TextToDisplay:="Outlook " + linkType + " : " + linkName)


        ' font correction (if desired)


           oLink.Range.Font.Name = "Courier New"
           oLink.Range.Font.Size = 10
        '   oLink.Range.Font.Color = vbRed
        
        ' Copy the body of the mail (the hyperlink) to the clipboard
        
        oLink.Range.Copy
        
        ' Throw away the temp mail
        
        olTemp.Close olDiscard
        
    End With
    
lbl_Exit:


    Set olTemp = Nothing
    Set olInsp = Nothing
    Set olItem = Nothing
    Set oLink = Nothing
    Set oRng = Nothing
    Set wdDoc = Nothing
    Exit Sub
    
End Sub