Use the following VBA code to create a contact picker to link contacts to tasks. You can change the code to allow for a manual pick of contacts folder, ie not hardcoded. If you have contacts stored in another folder, this change will make it easier to use.

To use a folder picker with other macros, use this code snippet to bring up the dialog:

Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder

Reconnect Links Macro

Sub ReconnectLinks()
    Dim objApp As Application
  Dim objNS As NameSpace
  Dim objFolder As MAPIFolder
  Dim colItems As Items
  Dim objItem As Object
  Dim colLinks As Links
  Dim objLink As Link
  Dim colContacts As Items
  Dim objContact As ContactItem
  Dim strFind As String
  Dim intCount As Integer
  Dim myFolder1 As MAPIFolder


  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  'set contacts folder
  Set myFolder1 = objNS.PickFolder
  'set tasks folder
  Set objFolder = objNS.PickFolder
  If TypeName(objFolder) <> "Nothing" Then
    'Set colContacts = objNS.GetDefaultFolder(olFolderContacts).Items     
    Set colContacts = myFolder1.Items
    Set colItems = objFolder.Items
    For Each objItem In colItems

      Set colLinks = objItem.Links
      intCount = colLinks.Count
      If intCount > 0 Then
        For i = intCount To 1 Step -1
          Set objLink = colLinks.Item(i)
          On Error Resume Next

          If objLink.Item Is Nothing Then

            strFind = "[FullName] = " & AddQuotes(objLink.Name)
            Set objContact = colContacts.Find(strFind)

            If Not objContact Is Nothing Then
            ' remove the old link
            colLinks.Remove i
            ' add the replacement link
            colLinks.Add objContact
            End If
          End If
        Next
        If Not objItem.Saved Then
          objItem.Save
        End If
      End If
    Next
  End If

  Set objLink = Nothing
  Set colLinks = Nothing
  Set objItem = Nothing
  Set objItems = Nothing
  Set objFolder = Nothing
  Set objNS = Nothing
    Set objApp = Nothing
End Sub

Private Function AddQuotes(MyText) As String
    AddQuotes = Chr(34) & MyText & Chr(34)
End Function