How to Extract the EMailTo from Icons

[PosseJohn]

I import a list that contains the EmailTo: address for everyone in the list.

I want to extract the address, and present in a cell as text, using VBA.

I have >2500 items to perform on.

Picture below:
EmailIcons.jpg

[PosseJohn]

Well, I noodled it out...

Sub RetrieveEmailAddress()
Dim shp As Shape

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    For Each cl In Range("R3:R2619").Cells  'Range of Icons
        Application.StatusBar = cl.Row
        varRow = cl.Row
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address(0, 0) = "R" & varRow Then
                cl.Offset(0, 1) = shp.Hyperlink.Address
            End If
            shp.Delete
        Next shp
    Next cl
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .StatusBar = False
    End With
    
End Sub