ハイパーリンクが設定されているセルを、Outlookの本文に挿入

'**********************************
'* rng：ハイパーリンクが設定されているRange
Sub InsertHyperlinkInOutlookEmail(ByVal rng As Range)

    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim cellValue As String
    Dim cellHyperlink As String
    
    ' Outlook アプリケーションを取得
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' 新しいメール作成
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' T1セルの値を取得
    cellValue = rng.Value
    
    ' U12セルのハイパーリンクを取得
    cellHyperlink = rng.Hyperlinks(1).Address
    
    ' メール本文にハイパーリンク挿入
    outlookMail.HTMLBody = "<a href=""" & cellHyperlink & """>" & cellValue & "</a>"
    
    ' メール表示
    outlookMail.Display
    
    ' オブジェクトの解放
    Set outlookMail = Nothing
    Set outlookApp = Nothing

End Sub

Private Sub 使用例()
    ' ハイパーリンクが設定されているセルを指定
    Call InsertHyperlinkInOutlookEmail(Sheets("Sheet1").Range("A1"))
End Sub