VBAで作成するメール(開封確認の要求設定)

このQ&Aのポイント
  • VBAを使用してエクセルで定型メールを作成するマクロを作成しました。
  • しかし、作成したメールに開封確認の要求を追加する方法を知りません。
  • 指定したシートから要求の有無を設定したいと考えています。
回答を見る
  • ベストアンサー

VBAで作成するメール(開封確認の要求設定)

 エクセルにて、毎日送信する定型メールを作成するマクロを作成しましたが、作成したメールに開封確認の要求を追加する設定がわかりません。エクセルのシートから要求の有無を指定させたいと考えています。もし、ご存じの方がいましたら、お知恵を拝借いただきたいです。  なお、エクセルでマクロを起動し、Outlook.Applicationのオブジェクトでメールを作成して、シートの内容を各設定に組み込むという形をとっています。OSはWindowsXP、Office2007のOutlookでメールを作成しています。  投稿は今回が初めてで不慣れな点がありますが、不備等をご指摘いただければ幸いです。宜しくお願い致します。 -----------------------以下マクロの内容------------------------ Option Explicit Sub MAKE_MAIL_ITEM() Dim Tool As Workbook Dim Sheet As Worksheet Dim myoApp As Object Dim myoExp As Object Dim myNameSpace As Object Dim myFolder As Object Dim objMAIL As Object Dim SendDay As String Set Tool = ThisWorkbook Set Sheet = Tool.ActiveSheet ' Outlookアプリのオブジェクト設定 Set myoApp = CreateObject("Outlook.Application") ' Outlookの規定フォルダをオブジェクト設定 Set myNameSpace = myoApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) ' Outlookで表示されているフォルダのアクティブ設定 Set myoExp = myoApp.ActiveExplorer ' アクティブフォルダがなければOutlook起動(表示) If myoExp Is Nothing Then myFolder.display End If ' メールアイテムの作成 Set objMAIL = myoApp.CreateItem(0) ' 日付の取り込み SendDay = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" ' メールの表示 objMAIL.display ' 宛先設定 objMAIL.To = Sheet.Cells(2, 2) ' CC設定 objMAIL.CC = Sheet.Cells(3, 2) ' Subjectを設定([$#Today#$]があれば日付に変換) objMAIL.Subject = Replace(Sheet.Cells(4, 2), "[$#Today#$]", SendDay) ' 本文の代入([$#Today#$]があれば日付に変換) objMAIL.Body = Replace(Sheet.Cells(5, 2), "[$#Today#$]", SendDay) End Sub

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

  • ベストアンサー
  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.1

OutLookのVBAのHelpで検索したら ReadReceiptRequested プロパティ 関連項目 対象 使用例 アプリケーション情報 True を設定すると、開封確認のメッセージが要求されます。このプロパティは、MAPI プロパティの PR_READ_RECEIPT_REQUESTED に対応しています。値の取得および設定が可能です。 expression.ReadReceiptRequested expression 必ず指定します。MailItem オブジェクトを表すオブジェクト式を指定します。 のがありました。 objMAIL.ReadReceiptRequested=True とかで試してみては如何でしょうか。

junroku
質問者

お礼

ご回答ありがとうございます。 どこかにあるだろうと思っていましたが、 いくら探してもなかったので助かりました。 これで開封確認設定の使い分けができるようになりました。 どうもありがとうございました。

関連するQ&A

  • <EXCEL/VBA> OUTLOOKのウインドを閉じる方法

    EXCEL/VBAで、OUTLOOKのウインドを閉じる方法を教えて下さい。 OUTLOOKを立ち上げた状態で、EXCEL/VBAで下記のようにOUTLOOKのフォルダーを指定してウインドを表示していますが、 VBAで開いたウインドのみ閉じたいのですが、うまく行きません。 oApp.Quitだと元々立ち上げていたoutlookも含めて終了してしまいます。宜しく、お願いします。 Sub OL_TEST() Dim oApp As Object 'OutlookのApplication オブジェクト Dim myNameSpace As Object '名前スペース Dim myFolder As Object 'フォルダー指定 Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定 myFolder.Display '表示

  • 本文が最後に表示されてしまいます。

    以下内容でVBAを組んで、メールにコピペさせたんですが 本文が下に行き、コピーしたグラフが先に表示されます。 どうにか、  "お疲れ様です。" & vbCrLf _ & "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _ & "印刷された用紙で、前確FAXを送信してください。" &vbCrLf _ & "尚、以下内容で、前確FAX送信いたします。" の部分を本文のトップに持って来れないでしょうか? VBAは下記のように書いております。 Sub Outlookforexcel() '※1 Dim oApp As Object Dim myNameSpace As Object Dim myFolder As Object Dim objMAIL As Object 'メールのオブジェクト Dim strMOJI As String '本文 'outlook 起動 Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定 'メールアイテムの作成 Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 直値はいけないと思いつつ、 objMAIL.BodyFormat = 3 'olFormatRichText=3 で リッチテキスト形式へ '宛先・件名・本文 などのデータを代入する objMAIL.To = Range("O1") '宛先 .TO セルO3から代入 objMAIL.Cc = Range("O2") objMAIL.Subject = "【確認FAX】印刷終了以下内容で送信します。" '.Subjectで件名 strMOJI = "お疲れ様です。" & vbCrLf _ & "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _ & "印刷された用紙で、確認FAXを送信してください。" & vbCrLf _ & "尚、以下内容で、確認FAX送信いたします。" DoEvents objMAIL.Body = strMOJI '本文の初期化 DoEvents objMAIL.Display '画面表示(Mail入力、編集画面を表示) DoEvents 'Outlook貼り付けのコマンドをコマンドバーから探す Dim oCBs As Object Dim oCtl As Object '今起動中のobjMAIL(メール作成中)のコマンドバーを取り出すよ Set oCBs = objMAIL.GetInspector.CommandBars 'ループで貼り付けの文字を探す、、、 Dim I As Long 'カウンター For I = 1 To 35000 'コントロール I 番目を取り出す Set oCtl = oCBs.FindControl(, I) If Not (oCtl Is Nothing) Then 'オブジェクトが空じゃなければ '文字列でコマンド名を比較する Debug.Print ".Caption " & oCtl.Caption If oCtl.Caption = "貼り付け(&P)" Then ' ↑で見つけたら oCtlはそのままで、ループを抜ける。 Exit For 'これ以上はループしないでいいので。 End If End If Next 'コピー(Excelから)と貼り付け(Outlookへ)処理 Range("A1:I80").Select 'Excel Selection.Copy DoEvents oCtl.Execute '↑で見つけたoCtl 貼り付けコマンド(outlook)を実行 DoEvents objMAIL.send '送信箱へ ※セキュリティの警告メッセージが出るよ 'ここで、普通はオブジェクトの開放など、後始末をする。 Set oCtl = Nothing Set oCBs = Nothing End Sub

  • エクセルVBAでOutlookメールの書式を変える

    エクセル2010です。 下記のようなコードでOutlookメールを作成したとき、たとえば  "ABC株式会社" だけを赤字で太文字にするにはどう書けばよいのでしょうか? Sub TEST001()   Dim oApp As Object   Dim objMAIL As Object   Dim strMOJI(1) As String   On Error Resume Next   Set oApp = GetObject(, "Outlook.Application")   On Error GoTo 0   If oApp Is Nothing Then     Set oApp = CreateObject("Outlook.Application")   End If   Set objMAIL = oApp.CreateItem(0)   strMOJI(0) = "こんにちは!" & vbCrLf & _   "色付けテストです。" & vbCrLf & _   "よろしくおねがいします。" & vbCrLf   strMOJI(1) = vbCrLf & _   "以上です。" & vbCrLf & _   "ABC株式会社" & vbCrLf & _   "emaxemax"   objMAIL.To = "xxxx@xxx.co.jp"   objMAIL.CC = "yyyy@xxx.co.jp"   objMAIL.Subject = "テスト"   objMAIL.Body = strMOJI(0) & strMOJI(1)   objMAIL.Display End Sub

  • エクセルVBAでメールに画像添付

    エクセル2010です。 以下のようなVBAでOutlookメールを作成しているのですが、本文の中に画像を添付する方法がわかりません。 下記で言えば strMOJI(0) と strMOJI(1) の間に画像を張り付けたいのです。 画像ファイルを添付するのではなく画像として見えるようにしたいのです。 どのように書けばよろしいでしょうか? Sub TEST001()   Dim oApp As Object   Dim objMAIL As Object   Dim strMOJI(1) As String   On Error Resume Next   Set oApp = GetObject(, "Outlook.Application")   On Error GoTo 0   If oApp Is Nothing Then     Set oApp = CreateObject("Outlook.Application")   End If   Set objMAIL = oApp.CreateItem(0)   strMOJI(0) = "こんにちは!" & vbCrLf & _   "テストです。。" & vbCrLf & _   "よろしくおねがいします。" & vbCrLf   strMOJI(1) = vbCrLf & _   "以上です。" & vbCrLf & _   "ABC株式会社" & vbCrLf & _   "emaxemax"   objMAIL.To = ""   objMAIL.CC = "xxxx@xxx.co.jp"   objMAIL.Subject = "テスト"   objMAIL.Body = strMOJI(0) & strMOJI(1)   objMAIL.Display End Sub

  • outlookが起動してるかどうかを取得したい

    Sub Outlookが起動してないなら起動する() Dim oApp 'As Outlook.Application OutlookのApplication オブジェクトを入れる Dim myNameSpace 'As Outlook.NameSpac Dim myFolder 'As Outlook.Folder If Outlookが起動してるなら Then Exit Sub 'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー myFolder.Display '(通常サイズ olNormalWindow=2 , olMaximized=0,olMinimized=1) oApp.ActiveWindow.WindowState = 0 End Sub ///////////////////////////////////////////////////////////////// のような事がしたいのですが、 If Outlookが起動してるなら Then Exit Sub をどうすればいいのか教えていただけませんか? 当方OFFICE2007を使用しています。

  • outlookの予定をexcelから読む

    Office2007を使っています。 予定作成のフロントエンドとしてoutlook、 全体の予定表の作表、印刷エンジンとしてexcel、という使い方をしたいです Dim oApp 'As Outlook.Application OutlookのApplication オブジェクトを入れる Dim myNameSpace 'As Outlook.NameSpace 名前のスペースと言われても、、 Dim myFolder 'As Outlook.Folder フォルダー指定 Dim shigoto Dim aITEM 'As Outlook.AppointmentItem '予定、アポ Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定 Set shigoto = myFolder.Folders("予定表(仕事)") shigoto.display oApp.ActiveWindow.WindowState = 2 'olNormalWindow=2 を セット For Each aITEM In shigoto.Items 'aITEMに入っている個々の予定に対する処理 Next http://www.ken3.org/cgi-bin/group/vba_outlook.asp 上記サイトのコードで、規定の予定表にある予定オブジェクトにアクセスすることはできました これを、iCloud内の予定表に対して同じことをやりたいのですが、うまくいきません。 Set shigoto = myFolder.Folders("iCloud内の予定表(仕事)") Set shigoto = myFolder.Folders("iCloud").Folders("予定表(仕事)") などとやってみたのですが、 実行時エラー'-2147221283(8004010f)": 操作は失敗しました。オブジェクトが見つかりませんでした。 というエラーで終了です。 うまくいく方法はないでしょうか? よろしくお願いします。

  • マクロのメール作成について教えてください

    メール作成に関するマクロで教えて下さい。 下記のマクロで、件名と文章内の#○○○の○○○の部分には 毎回違う3ケタの数字が入ります。 これを例えば、エクセルのセルA1に101と入力されていたら 件名と文章内の○○○の部分を101にした状態でメールを起動させたいです。 また最後の名前○○の部分には、セルA2にデータ入力規則でリストを作成し 選んだ名前を選択すると○○の部分が反映された状態でメールが起動するようにしたいです。 それと文章内の書体をMS P明朝にするにはどうすればよいでしょうか? 教えて下さい。 Sub メールマクロ() Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String Dim n As Long On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application") oApp.GetNamespace("MAPI").GetDefaultFolder(6).display End If Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "【秘/Confidential】 " & vbCrLf & _ "テスト様" & vbCrLf & _ "CC.関係各位様" & vbCrLf & _ " " & vbCrLf & _ "いつもお世話になっております。" & vbCrLf & _ "#○○○ G1 G2の計測を行いました" & vbCrLf & _ "以上です。" & vbCrLf & _ "EMAX株式会社" & vbCrLf & _ "名前○○" objMAIL.To = "E-Mail_Address_Here" objMAIL.Subject = "#○○○ G1 G2 計測結果" objMAIL.BodyFormat = 3 'リッチテキスト objMAIL.Body = strMOJI(0) objMAIL.display Set objMAIL = Nothing Set oApp = Nothing End Sub

  • Outlook2003 VBA マクロで迷惑フォルダ内のメールを一括削除したい

    行いたいことは、受信トレイ以下に「迷惑メール」と「迷惑メールフォルダ」というフォルダがあるのですが、これらのフォルダ内にあるメールを一括して削除するマクロを作成したいのです。 これまでは、フォルダを選択 → Ctrl+A → Delという操作を行っています。 ネット上のサンプルを参考に以下を作成しましたが、具合が良くないのです。1件づつループして削除させているので、数百件あると非常に処理が重くなるのです。 つまり、「Ctrl+A(全て選択) → Del」というようにさくっとした感じで処理がしたいのですが、その方法がわかりません。どうか、宜しくお願い致します。 Sub 複数のフォルダ内のメールを削除() 'お約束? Set myOlApp = CreateObject("Outlook.Application") Set myNameSpace = myOlApp.GetNamespace("MAPI") 'フォルダ指定 Set myFolder1 = myNameSpace.Folders("個人用フォルダ").Folders("迷惑メール") Set myFolder2 = myNameSpace.Folders("個人用フォルダ").Folders("迷惑メールフォルダ") '(1)「迷惑メール」内を削除 Dim cnt As Integer TOTAL = myFolder1.Items.Count For i = 1 To TOTAL '1番上のメールから順次削除 myFolder.Items(1).Display 'もしかして、これがいけない? myFolder.Items(1).Delete Next i '(2)「迷惑メール」内を削除 ・・・(1)と同様 End Sub 今回初めて、Outlook2003 VBAをさわってみましたので、基本がわかっていないと思います。ご指南頂ければ幸いです。

  • エクセルVBAでアウトルックメールの差出人変更

    エクセル2010です。 エクセルからVBAでアウトルックメールを作成するのですが、差出人を自分ではなく部門名のアドレスにしたいのです。 手動ではなんなく差出人を変更できるのですが、VBAでの方法がわかりません。 ネット検索してみると、 SendUsingAccount = Session.Accounts("アカウント名") でできるようなのですが、アカウント名がよくわかりません。 アカウント名に、手動で差出人を変更する際に「名前の選択」で指定する部門の名前や部門のアドレスなどを入れてみましたがオブジェクトが必要とのエラーになってしまいます。 どうすればよいのでしょうか? Sub TEST001() Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application") End If Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "こんにちは!" & vbCrLf & _ "差出人変更のテストです。。" & vbCrLf & _ "よろしくおねがいします。" & vbCrLf strMOJI(1) = vbCrLf & _ "以上です。" & vbCrLf & _ "ABC株式会社" & vbCrLf & _ "emaxemax" objMAIL.To = "" objMAIL.CC = "xxxx@xxx.co.jp" objMAIL.Subject = "テスト" objMAIL.Body = strMOJI(0) & strMOJI(1) ' objMAIL.SendUsingAccount = Session.Accounts("ABC Gyomubu")'ここでエラー objMAIL.Display End Sub

  • VBAで二重起動を防止したいのですが、

    VBAで二重起動を防止したいのですが、 いろいろ調べましたが、わかりませんでした。 なにかいい方法はないでしょうか? EXCELで見積書を作成して、そのファイルをVBAで保存するとき、ついでに、Outlook予定表に見積り期限日予定を入れるものです。 ファイル保存コード省略 Flnm=パス 'ここからアウトルック操作 Dim oApp As Object Dim myNameSpace As Object Dim myFolder As Object Dim objITEM As Object 'outlook 起動 Set oApp = CreateObject("Outlook.Application") '既に起動してても新規起動 Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(9) '起動時フォルダーを指定 myFolder.Display 'アイテムの作成 Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定 objITEM.Display '編集画面を表示 '予定表内容 objITEM.Subject = "見積り発行後のフォロー" '件名 objITEM.body = "見積り発行から3ヶ月経ちました" '本文 objITEM.Attachments.Add Flnm 'ファイルの添付 objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間 objITEM.Save '保存 objITEM.Close 2 '閉じる EXCEL2007とOutlook2007を使用しています。 1.多重起動しないことと 2.起動中で最小化されたOutlookがあるならアクティブ化して予定を入れる、または 3.起動していなかったら起動させて、予定を入れる と云うことがやりたいのですが・・・

専門家に質問してみよう