Copy a URL from a specific subject mail email body into excel worksheet

[abhay_547]

I want to copy the URL/Hyperlink from an outlook email which is received daily and consists of a 2 URL/hyperlinks and I want the second URL that starts with certain text like: http://mytkportal.si/sff/kp/sfsd=21133, the part highlighted in bold is same everyday but the last number keeps changing, So I want the macro to pull that link and paste into excel worksheet cell. I have got the below code which gets the entire email body but i need only the URL/hyperlink as mentioned above.

Sub CopyEmailtoExcel()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMi As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Test")
Set Fldr = Fldr.Folders("MyFolder")
Set inboxItems = Fldr.Items

pnldate = Format((Date - 1), "mm/dd/yyyy")

Set inboxItems = Fldr.Items
inboxItems.Sort "[ReceivedTime]", True
For i = 1 To Fldr.Items.Count Step 1
    Set olMi = Fldr.Items(i)
        If Format(olMi.ReceivedTime, "mm/dd/yyyy") = pnldate Then
            Debug.Print olMi.ReceivedTime
            Debug.Print olMi.Subject
            If InStr(1, olMi.Subject, "Breakdown") > 0 Then
                Sheets("Sheet1").Range("A1") = olMi.Body
                GoTo AllDone
            End If
        End If
Next i

AllDone:
End Sub