ハイパーリンクで設定されているファイル名をOutlookの件名に入れる

タイトルのサンプルは、以下です。

'***************************
'* rng:ハイパーリンクが設定されいるセル
Sub CreateOutlookEmailWithHyperlink(ByVal rng As Range)

    Dim outlookApp As Object
    Dim outlookMail As Object
    
    ' Outlook アプリケーションを取得
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' 新しいメール作成
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' 件名にハイパーリンクのファイル名を設定
    outlookMail.Subject = GetFileNameFromHyperlink(rng)
    
    ' メール表示
    outlookMail.Display
    
    ' オブジェクトの解放
    Set outlookMail = Nothing
    Set outlookApp = Nothing

End Sub

'***************************
'* rng:ハイパーリンクが設定されいるセル
Function GetFileNameFromHyperlink(ByVal rng As Range) As String
    Dim hyperlink As String
    
    ' T1セルのハイパーリンクを取得
    hyperlink = rng.Hyperlinks(1).Address
    
    ' ハイパーリンクのファイル名を抽出
    ' ここではファイルパスからファイル名の部分だけを取得する例を示しています。
    ' 実際の処理はファイルパスの形式により異なるため、適宜変更してください。
    GetFileNameFromHyperlink = Mid(hyperlink, InStrRev(hyperlink, "\") + 1)
End Function

以下が使用例です。

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

Follow me!