• 締切済み

Outlookの再送信フォームにてマクロで宛先を取得する方法について

Outlookの再送信フォームにてマクロで宛先を取得する方法について メールサーバーにEXCHANGE SERVER、メールクライアントにOutlook 2003を利用しています。 TOとCCに社外ドメインのアドレスが含まれていないか送信前にチェックするマクロを作成しました。 通常のメールの送信時には問題なく動作しているのですが、 配信不能のメールを再送信する際にエラーが出ます。 再送信フォームにて、メールの送信前に宛先を取得する方法をご存知の方がいらっしゃれば、 ご回答をお願いいたします。 【ソース】 ThisOutlookSessionにマクロを記述 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)   Dim i As Integer   For i = 1 To Item.Recipients.Count   ← この行でエラーが出ます。     With Item.Recipients.Item(i)     ~ 省略 ~     End With   Next End Sub 【エラーメッセージの内容】 実行時エラー '438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。

みんなの回答

回答No.1

For 文の前に以下のような記述を追加してみてください。 If TypeName(Item) = "ReportItem" Then Item.Save Set Item = Session.GetItemFromID(Item.EntryID) End If

loonytide
質問者

お礼

お返事が遅くなり申し訳ありません。 いまテストができる環境がないので、次の機会に早速試してみます。 ありがとうございました。

関連するQ&A

  • Outlook2007送信前の宛先確認のVBAにて

    Outlook2007 送信前の宛先確認のマクロを設定したいと考えています。 Option Explicit Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) On Error GoTo Ex ception Dim strCC strCC = vbCrLf Dim objRec As Recipients For Each objRec In Item.Recipients strCC = strCC & objRec.Name & vbCrLf Next Dim strMsg As String strMsg = "件名:" & Item.Subject & vbCrLf & _ _ strCC & vbCrLf & _ _ "上記の宛先に、メールを送信してもよろしいですか?" If MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then Cancel = True End If On Error GoTo 0 Exit Sub Exception: MsgBox CStr(Err.Number) & ":" & Err.Description, vbOkOnly + vbCritical Cancel = True Exit Sub これだけだと、End subが必要ですというポップアップがあがり、付加すると『型が一致しません』というポップアップがあがってしまいます。 どうすれば良いか教えていただけますか? あと、宛先をグループ登録してる場合、グループ登録している宛先を氏名で表示する方法はありますでしょうか??

  • outlookでマクロエラー

    メールを複数人に送信する場合、受信者に知られないように「B.C.C.」で送らなければならないのですが、 ついうっかり「To」や「C.C.」にアドレスを入れてしまい、相手からクレームをもらうということがありました。 それを未然に防ぐため、「To」や「C.C.」にアドレスに150文字以上入れたらアラートを出す、というマクロを以下のように作り、Visual Basic Editorに組み込みました。 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim strSubject As String strTo = Item.To strCC = Item.CC If Len(strTo) >= 150 Or Len(strCC) >= 150 Then Prompt$ = "ToかCCが150文字を超えています。本当に送信しますか?" If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "注意!") = vbNo Then Cancel = True End If End If End Sub このマクロは正常に動作するんですが、 問題は会議出席依頼を送信か承諾するときに 実行時エラー'438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。 というエラーが出るようになりました。 「終了」「デバッグ」「へルプ」が選択でき、 そこで「終了」を押すと普通に会議依頼は完了するのでし仕事上の問題はありません。 そこで「デバッグ」をすると strTo = Item.To のところが黄色くハイライトされます。 マクロも正常に動き、会議依頼もできるのですが、 毎回このエラーがでるので、なんとか直したいと思っています。 何か解決する方法ありますでしょうか。 環境はwindows XP、outlook2007です。 ご教授よろしくお願いします。

  • Outlookのメールを送信するマクロ

    お世話になっております。 Microsoft Outlook2003使用で メール送信のマクロを見様見真似で作ってみたのですが、本文部分がうまくいきません(Best regardsしか表示されません)。 どうすれば正しく反映されるでしょうか? シートのB1にToアドレスを記入していてTo_addressと名前付 以下、Cc_addressとSubjectも同様にしています。 本文の文章は何行かあり、途中で空白行も入れたいのですが、そこまでまだ手がつけられていません。 本文の文章が3行あるとすると、このマクロではComment1、Comment2、Comment3と名前付しています。 Sub SendEmail() 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 Comments As String Dim Comments2 As String Dim report As String Worksheets("Sheet1").Activate 'Create Outlook object  Set OutlookApp = New Outlook.Application 'Get the data Subj = Range("Subject") EmailAddr = Range("To_address") CCAddr = Range("Cc_address") Body = Range("Comment1") & ("Comment2") & ("Comment3") 'Compose message Msg = Msg & Comment1 & vbCrLf & vbCrLf Msg = Msg & Comment2 & vbCrLf & vbCrLf Msg = Msg & "Best regards," & vbCrLf & vbCrLf 'Create Mail Item Set mItem = OutlookApp.CreateItem(olMailItem) With mItem .To = EmailAddr .CC = CCAddr .BCC = BCCAddr .Subject = Subj .Body = Msg .Display End With End Sub 宜しくお願い致します。

  • マクロを削除したい(outlook2007)

    MIcrosoft Outlook 2007を使用しています。 次のマクロの削除方法を教えてくださいm(__)m メールを送信する際に、自動的にCCにアドレスを入れたく、ネットで探していたところ 次のようなマクロ(?)を設定すればOKとあったので、試してみました。 1.アウトルックを立ち上げる 2.alt+F11を押す 3.次を入力する  ↓ Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objMe As Recipient Set objMe = Item.Recipients.Add("アドレス@アドレス.jp") objMe.Type = olCC objMe.Resolve Set objMe = Nothing End Sub 4.保存する 以上の手順を踏みましたところ、確かに自動的にccにアドレスが入ってくれました。 しかし、あくまでも試しに入れてみましたので、削除をしたいと思ってるのですが、 削除の方法がわかりません。。。 試しに、上の文字列を削除して白紙で保存してみたりしましたが まったく直ってくれる気配がありません。。。 どなたか、削除方法をご教示いただけますでしょうか。 よろしくお願いいたしますm(__)m

  • エクセルからOUTLOOKでメール送信:2

    ●前回下記の質問を書かせていただきました。 ---------- エクセルに複数件のデータを記載してあります。 A列 に メールアドレス B列 に 件名 C列 に 本文A D列 に 本文B があるときに連続してメールを立ち上げ送信したいです。 いろいろ試してみましたが全く動きませんでした。 お手隙の際にでもお教え下さい。 マクロのサンプルソースがあると助かります。 よろしくお願いいたします。 ---------------- ●下記の回答をいただきメールの送信までは出来ました。 ---------------- Sub ボタン1_Click() Dim myOLApp As Object ' Dim myDATA As MailItem '### OUTLOOKのオブジェクトを作成後、メールを新規作成する。 Set myOLApp = CreateObject("Outlook.Application") For i=2 To 5 Set myDATA = myOLApp.CreateItem(olMailItem) '### メールの宛先、題名、本文、添付ファイルを設定する。 '(宛先のアドレス) myDATA.to = Range("A" & i).Value ' myDATA.CC = Range("D33").Value myDATA.Subject = Range("B" & i).Value myDATA.Body = Range("C" & i).Value & CHAR(10) & Range("D" & i).Value '### メールを送信 myDATA.Send Next '### お約束の後始末。 Set myDATA = Nothing Set myOLApp = Nothing End Sub こんな感じでしょうか。 For i=2 To 5 と 2行目から5行目です。 うまくいくようでしたら For i=2 To Range("A" &Rows.Count).End(xlUp).Row とでも変更してください。 なんといっても失敗すると大変なリスクが発生するプログラムです。 十分に実験してから運用してください。 ------------------------ ●メール送信は問題なくできておりましたが、  他のCSVリストよりエクセルにデータを引っ張ってきて  メールの送信を使用とした所 システムエラーです 80004005 エラーを特定できません。 と言ったエラーが出てくるようになりました。 多分他のシートから引っ張ってくる関数がジャマをしているとは思うのですが、 何かこのエラーを回避する方法はございますでしょうか? お教え下さい。

  • 【OUTLOOK2007】VBAを使用して送信済みメールの宛先メールア

    【OUTLOOK2007】VBAを使用して送信済みメールの宛先メールアドレスを取得したい OUTLOOK2007を使用しています。 以下のVBAを使用して、送信済みメールの宛先の"メールアドレス"を取得しようと 考えています。 Sub getTo() Set myFolder = Application.ActiveExplorer.CurrentFolder For Each myItem In myFolder.Items debug.print myItem.To Next myItem End Sub 送信済みメールフォルダを選択し、上記VBAを実行すると、 狙い通り宛先(myItem.Toの値)は取得できるのですが、 宛先がメールアドレス(例:suzuki@**.com)ではなく、 名前(例:鈴木)になってしまっているメールに関しては、 myItem.Toの値も“メールアドレス”ではなく名前になってしまいます。 どなたか、ご存知でしたら、 確実に宛先のメールアドレスを取得する方法をご教示いただけますでしょうか。 何卒、お願い申し上げます。

  • マクロで携帯にメール送信

    いつもお世話になっております。 過去に何度か質問をさせていただき、今回のマクロまでたどり着くことが出来ました。 下記の内容にて、作成しました。 ここで、 (1)セルB1にあて先メアドを置いた場合に、メアドを載せる場合 (2)メールを送信する命令で、【myItem.Send】や【SendMail】ではメールが送信されている場合と送信待機の場合がはっせいしております。必ず、送信するまでの命令を、お教えいただきたいです。 PC環境は、XPです。 メールはMicrosoft Office Outlookです。 Sub CreateMail() '参照設定 : Miscosoft Outlook 9.0Object Library Const ShName = "MAIL送信" Const SbjAdd = "b2" Const BodyAdd = "b3:b14" Dim olApp As Outlook.Application Dim objMail As Outlook.MailItem Dim Rng As Range Dim StrBody As String Set olApp = Outlook.Application Set objMail = olApp.CreateItem(olMailItem) For Each Rng In Range(BodyAdd) StrBody = StrBody & Rng.Value & vbLf Next Rng With objMail .Subject = Worksheets(ShName).Range(SbjAdd).Value .Body = StrBody .Display End With End Sub

  • エクセル2010マクロ ping送信マクロ作成

    初めて質問します。マクロ初心者です。 ある複数のIPアドレスに対してpingを送信し、 ●正常ならば正常 ●”宛先ホストに到達できません”、もしくは”受信=0”のときエラー をそれぞれ返すマクロを作成したいと考えております。 ネットで検索して下記のマクロを作成したのですが、正常と”受信=0”は判別できても ”宛先ホストに到達できません”も正常として返してしまうので困っております。 どなたかご教授くださいませ。宜しくお願い致します。 ※マクロの概要です。 D5~D89にIPアドレスを入力。 正常ならばそれぞれ対応した行のE列に”0”を。 異常ありならば、それぞれ対応した行のE列に”1”、F列に”エラー”を入力。 Sub ping送信マクロ  For i = 5 To Cells(Rows.Count, 4).End(xlUp).Row cmd = "cmd.exe /c ping " & Cells(i, 4) Set objWSH = CreateObject("WScript.Shell") If objWSH.Run(cmd, vbNormalFocus, True) Then Cells(i, 5) = "1" Cells(i, 6) = "エラー" Else Cells(i, 5) = "0" End If Set objWSH = Nothing Next End Sub アドバイスはもちろんですが、何分マクロ触りたてですので”例”として完成したものを 載せて頂けると非常に助かります!

  • エクセル フォーム上の全てのコントロールを取得した

    エクセル フォーム上の全てのコントロールを取得したい http://okwave.jp/qa/q4879853.html のNo.1さんの回答を参考に、 Sub try() Dim i As Integer Dim StrFormName As String StrFormName = "フォーム1" For i = 0 To Forms(StrFormName).Controls.Count - 1 Debug.Print Forms(StrFormName).Controls.Item(i).Name Next End Sub を作ったのですが、 「Forms」の部分が、 「Sub、Function、または Property が定義されていません。(Error 35)」 というコンパイルエラーになってしまいます。 上記のコードをアクセスVBAにつけると、全てのコントロール名が取得できます。 同じようにエクセルで使うにはどこを修正すればいいでしょうか? フォーム名は、変数に入れて使いたいです。

  • Outlook2013自動送信が出来ません。

    はじめまして、いつもお世話になっております。 excel vba の学習を始めたばかりの初心者です。 あるサイトで自動でoutloook2013を起動しファイルを添付して送信するマクロを 見つけ送信しようとしましたが、『コンパイルエラー』の為、上手くいきません。 どなたか画像をご確認いただき、修正方法をご教示いただきたく存じます。 よろしくお願いいたします。 以下がコンパイルエラーの出たプロシージャ(抜粋) 黄色のライン→Sub sendmail_sample1() 反転→Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成 以下がコンパイルエラーの出たプロシージャ(全体) Sub sendmail_sample1() '---コード1|outlookを起動する Dim toaddress, ccaddress, bccaddress As String '変数設定:To宛先、cc宛先、bcc宛先 Dim subject, mailBody, credit As String '変数設定:件名、メール本文、クレジット、添付 Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成 Dim mailItemObj As Outlook.MailItem 'Outlookで使用するオブジェクト生成 '---コード2|差出人、本文、署名を取得する--- toaddress = Range("B2").Value 'To宛先 ccaddress = Range("B3").Value 'cc宛先 bccaddress = Range("B4").Value 'bcc宛先 subject = Range("B5").Value '件名 mailBody = Range("B6").Value 'メール本文 credit = Range("B7").Value 'クレジット '---コード3|メールを作成して、差出人、本文、署名を入れ込む--- Set outlookObj = CreateObject("Outlook.Application") Set mailItemObj = outlookObj.CreateItem(olMailItem) mailItemObj.BodyFormat = 3 'リッチテキストに変更 mailItemObj.To = toaddress 'to宛先をセット mailItemObj.CC = ccaddress 'cc宛先をセット mailItemObj.BCC = bccaddress 'bcc宛先をセット mailItemObj.subject = subject '件名をセット '---コード4|メール本文を改行する mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット '---コード5|自動で添付ファイルを付ける--- Dim attached As String Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成 Set myattachments = mailItemObj.Attachments attached = Range("B9").Value '添付ファイル myattachments.Add attached attached = ThisWorkbook.Path & "outlookメール操作.xlsm" '---コード6|メールを送信する--- 'mailItemObj.Save '下書き保存 mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない) '---コード7|outlookを閉じる(オブジェクトの解放)--- Set outlookObj = Nothing Set mailItemObj = Nothing

専門家に質問してみよう