エクセルからOutlookメールを起動させて本文にハイパーリンクを張らせたい

エクセルからメールを起動して
本文の一部分にサイトへ飛べるURLをハイパーリンクとして埋め込みたい。
下記マクロを修正、ご教示ください。

1行目は見出し
2行目からデータ

まず、Text4 = Range("I2").Valueの部分を
I列の2行目から最終行までと書き換えたいです。
途中、空白は無いとします。

次に
I列には数値が入っています。
Msg = Msg & "<A HREF=""http://～(省略)id="">*******</A> " & "<BR>"　の
"<A HREF=""http://～(省略)id="">にI2、I3、I4・・・の数値を付加させたいです。

例：http://～(省略)id=123456789

更に、メール本文には、I列の数値を表示させると、
http://～(省略)id=123456789　をリンクさせたいです。

I列は見出しを除いて1行のみの場合もあれば、数行の場合もあります。
データは、I列のみが増えていきます。他列は見出しを除く1行で完結。

なので、メールには
123456789 (←http://～(省略)id=123456789がハイパーリンク)
987654321 (←http://～(省略)id=987654321がハイパーリンク)
・・・以下、続く

数値(例：123456789)をクリックするとサイトへ飛べるようにするのが目的です。
宜しくお願い致します。

Sub エクセルからメール送信()

Dim OlApp As Outlook.Application
Dim mItem As Outlook.MailItem

Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim Message As String
Dim Sender As String
Dim Texts As String
Dim Texts2 As String
Dim report As String

Worksheets("Sheet1").Activate

Set OutlookApp = New Outlook.Application
Subj = Range("C2")
EmailAddr = Range("A2")
CCAddr = Range("B2")

Text1 = Range("D1").Value & "<BR>" & Range("D2").Value
Text2 = Range("E1").Value & "<BR>" & Range("E2").Value & "様"
Text3 = Range("F2").Value
Text4 = Range("I2").Value

Msg = Msg & Text1 & "<BR>"
Msg = Msg & Text2 & "<BR>"
Msg = Msg & Text3 & "<BR>"
Msg = Msg & "<A HREF=""http://～(省略)id="">*******</A> " & "<BR>"
Msg = Msg & "宜しくお願い致します。" & "<BR>"

Set mItem = OutlookApp.CreateItem(olMailItem)
With mItem
.To = EmailAddr
.CC = CCAddr
.BCC = BCCAddr
.Subject = Subj
.HTMLBody = Msg
.Display

End With
End Sub

※ マクロは某サイトの既存物を参考にしました

No.1 回答者： hallo-2007 回答日時： 2015/08/08 15:06

とりあえず

>まず、Text4 = Range("I2").Valueの部分を
>I列の2行目から最終行までと書き換えたいです。
の部分だけですが


For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Subj = Range("C" & i)
EmailAddr = Range("A" & i)
CCAddr = Range("B" & i)
・・・・
Next

と云った具合に、For ～Next　で繰り返させます。
Range("A" & Rows.Count).End(xlUp).Row
がA列にデータが入っている最終行番号を取得する構文と思ってください。
Range("A" & Rows.Count).
一旦、A列の一番下（２００７以降であれば、1048576）へ移動して、
End(xlup)で空白でない最後の行へ移動して
.Row　でその行番号
となります。