Sub メール文面をテキストボックスver.()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim ws As Worksheet
Dim Response As VbMsgBoxResult
Dim AttachFiles As Variant
Dim i As Integer
Dim ToRecipients As String
Dim CCRecipients As String
Dim BCCRecipients As String
Dim MailBody As String
Dim MailBody2 As String
' シートの設定
Set ws = Sheets("Sheet1")
' テキストボックスの内容を取得
MailBody = ws.Shapes("TextBox1").TextFrame.Characters.Text
MailBody2 = ws.Shapes("TextBox2").TextFrame.Characters.Text
' 確認ポップアップを表示
Response = MsgBox("メールを送信しますか？", vbYesNo + vbQuestion, "確認")
If Response = vbYes Then
' Outlookアプリケーションを起動
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0) ' 0はメールアイテムを指す
' 複数の宛先をセミコロンで区切って結合
ToRecipients = Replace(ws.Range("B1").Value, ",", ";")
CCRecipients = Replace(ws.Range("B2").Value, ",", ";")
BCCRecipients = Replace(ws.Range("B3").Value, ",", ";")
With OutlookMail
.To = ToRecipients
.CC = CCRecipients
.BCC = BCCRecipients
.Subject = ws.Range("B5").Value
.Body = MailBody & vbCrLf & vbCrLf & MailBody2
If ws.Range("C4").Value Then
If ws.Range("B4").Value <> "" Then
' 添付ファイルのパスを分割
AttachFiles = Split(ws.Range("B4").Value, ";")
For i = LBound(AttachFiles) To UBound(AttachFiles)
.Attachments.Add Trim(AttachFiles(i))
Next i
Else
MsgBox "添付ファイルのパスが指定されていません。", vbExclamation, "エラー"
Exit Sub
End If
End If
.Display ' メールを表示して確認（送信せずに表示）
'.Send ' 確認なしで送信する場合はこの行をコメントアウト解除
End With
' オブジェクトの解放
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Else
MsgBox "メール送信がキャンセルされました。", vbInformation, "キャンセル"
End If
End Sub
Excel→Outlookメール送信(メール文面をテキストボックスver.)
