解決済み

「いいね」メールを送信するVBAの修正について

  • 困ってます
  • 質問No.9588360
  • 閲覧数209
  • ありがとう数3
  • 気になる数0
  • 回答数1
  • コメント数0

お礼率 74% (593/794)

【環境】Windows10、Outlook2016

【ご教示いただきたい点】
Outlook on the webには「いいね!」機能がありますが、Outlook2016には「いいね!」機能がないので、探していたところ、以下のサイトが見つかりました。

意図しないメールが選択されている状態で「いいね」ボタンを押すとそのメールがそのまま送信されるため、「いいね」ボタンを押した後、宛先、件名を表示して、「はい」ボタンを押した場合にメールを送信する、「いいえ」ボタンを押した場合、メールを送信しないようにしたいのですが、どのようにしたらよいでしょうか。

Outlook/VBAで「いいね!」ボタンを作ってみた
http://pineplanter.moo.jp/non-it-salaryman/2017/09/15/like-on-outlook/

--
Sub pressLike()
Dim mItem As MailItem

If TypeName(Application.ActiveWindow) = "Inspector" Then
Set obj = ActiveInspector.CurrentItem
Else
Set obj = ActiveExplorer.Selection(1)
End If

Set mItem = obj.Reply
sname = getName(mItem.Body)
mItem.HTMLBody = "<div style=""text-align:center;border:1px solid #000099;padding:10px;background:#eef;"">" & _
sname & "さんがあなたのメールを「いいね」と言っています。</div>" & vbCrLf & mItem.HTMLBody

'mItem.Display
mItem.Send 'メール送信
End Sub

Function getName(t)
If InStr(t, "To:") > 0 Then
result1 = Split(t, "To:")
result2 = Split(result1(1), vbCrLf)

getName = result2(0)
Else
getName = "このメール送信者"
End If
End Function
--

質問者が選んだベストアンサー

  • 回答No.1

ベストアンサー率 59% (904/1507)

[技術者向] コンピューター カテゴリマスター
OutlookのVBAでは選択をさせる機能がありませんから、Set obj=で取得したobjからメールのタイトルや送信者を取得して、MsgBoxでこのメールで良いか問うしかないと思います。
補足コメント
Engineer480907

お礼率 74% (593/794)

ありがとうございます。

送信する前に、確認するダイアログを出すようにはできましたが、「いいね」を送信する先の宛先、件名をMsgBoxに表示するようには修正できていないので、送信する先の宛先、件名をセットする方法を調べて試してみたいと思います。

Sub pressLike()
Dim mItem As MailItem

If TypeName(Application.ActiveWindow) = "Inspector" Then
Set obj = ActiveInspector.CurrentItem
Else
Set obj = ActiveExplorer.Selection(1)
End If

Set mItem = obj.Reply
sname = getName(mItem.Body)
mItem.HTMLBody = "<div style=""text-align:center;border:1px solid #000099;padding:10px;background:#eef;"">" & _
sname & "さんがあなたのメールを「いいね」と言っています。</div>" & vbCrLf & mItem.HTMLBody

If MsgBox("「いいね」を送信しますか?", vbYesNo) = vbYes Then
' mItem.Display
mItem.Send 'メール送信
End If
End Sub

Function getName(t)
If InStr(t, "To:") > 0 Then
result1 = Split(t, "To:")
result2 = Split(result1(1), vbCrLf)

getName = result2(0)
Else
getName = "このメール送信者"
End If
End Function
投稿日時 - 2019-02-16 23:35:20
お礼コメント
Engineer480907

お礼率 74% (593/794)

ありがとうございます。

送信する前に、確認するダイアログとして「いいね」を送信する先の宛先、件名をMsgBoxに表示するように修正しました。

Sub pressLike()
Dim mItem As MailItem

If TypeName(Application.ActiveWindow) = "Inspector" Then
Set obj = ActiveInspector.CurrentItem
Else
Set obj = ActiveExplorer.Selection(1)
End If

Set mItem = obj.Reply
sname = getName(mItem.Body)
mItem.HTMLBody = "<div style=""text-align:center;border:1px solid #000099;padding:10px;background:#eef;"">" & _
sname & "さんがあなたのメールを「いいね」と言っています。</div>" & vbCrLf & mItem.HTMLBody

If MsgBox("「いいね」を送信しますか?" & vbCrLf & vbCrLf & "【宛先】 " & mItem.To & vbCrLf & "【件名】 " & mItem.Subject, vbYesNo) = vbYes Then
' mItem.Display
mItem.Send 'メール送信
End If
End Sub

Function getName(t)
If InStr(t, "To:") > 0 Then
result1 = Split(t, "To:")
result2 = Split(result1(1), vbCrLf)

getName = result2(0)
Else
getName = "このメール送信者"
End If
End Function
投稿日時 - 2019-02-16 23:52:43
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集

ピックアップ

ページ先頭へ