Hello!) I need your help again. Is it possible to make something like this for MS Project? I want to create hyperlinks to tasks

P.S. I have improved code for Outlook to creating hyperlinks to other Outlook objects
[SPOILER]
Sub CopyLink()
    Dim olTemp As Outlook.MailItem
    Set olTemp = CreateItem(olMailItem)
            
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oLink As Object
    Dim oRng As Object
    
    Dim linkName
    Dim linkID
    
    Dim doClipboard As DataObject
    Set doClipboard = New DataObject
    
    'One and ONLY one message muse be selected
    If Application.ActiveExplorer.Selection.Count <> 1 Then
        MsgBox ("One and ONLY one message muse be selected")
        Exit Sub
    End If
    
    Dim SelectedItem
    SelectedItem = TypeName(Application.ActiveExplorer.Selection.Item(1))
    
    If SelectedItem = "MailItem" Then
        Dim objMail As Outlook.MailItem
        Set objMail = Application.ActiveExplorer.Selection.Item(1)
        linkName = objMail.Subject
        linkID = objMail.EntryID
    Else
    If SelectedItem = "TaskItem" Then
        Dim objTask As Outlook.TaskItem
        Set objTask = Application.ActiveExplorer.Selection.Item(1)
        linkName = objTask.Subject
        linkID = objTask.EntryID
    Else
    If SelectedItem = "ContactItem" Then
        Dim objContact As Outlook.ContactItem
        Set objContact = Application.ActiveExplorer.Selection.Item(1)
        linkName = objContact.FullName
        linkID = objContact.EntryID
    Else
    If SelectedItem = "NoteItem" Then
        Dim objNote As Outlook.NoteItem
        Set objNote = Application.ActiveExplorer.Selection.Item(1)
        linkName = objNote.Subject
        linkID = objNote.EntryID
    Else
    If SelectedItem = "AppointmentItem" Then
        Dim objAppoint As Outlook.AppointmentItem
        Set objAppoint = Application.ActiveExplorer.Selection.Item(1)
        linkName = objAppoint.Subject
        linkID = objAppoint.EntryID
    Else
        MsgBox ("Invalid object selected")
        Exit Sub
    End If
    End If
    End If
    End If
    End If
    
	'Create temp message
    With olTemp
        .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:=linkName)


    'font correction
        oLink.Range.Font.Name = "Adobe Fan Heiti Std B"
        oLink.Range.Font.Size = 10
        'oLink.Range.Font.Color = vbRed


        Set oRng = oLink.Range
        oRng.Copy
        olTemp.Close olDiscard
    End With
    
End Sub
[/SPOILER]