Q&A
質問者様。コメントにされている
Range("F" & n).Value = Left(objmailItem.Body, 100)
ここで本文が取得できていないのですか？
それとも「意味不明の文字列」が取得されているのですか？
Microsoft Exchange office365 outlookを社内ネットワーク環境下でメールの送受信などをおこなっています。
背景
ExcelVBAを使って、outlookメール受信情報をExcelに出力するVBAを作成し試しているのですが
受信日とメールの題名は取り込めるのですがしか、肝心の送信者とメール全文を取り込むことが出来ません。
原因はおそらく社内ネットワーク環境下での使用かと推測するのですが、対処方法がわからず困ってしまいました。
要望
Microsoft Exchange office365 outlookのメール受信情報を
Excelに出力（送信者とメール全文）するVBAコード問題の対策方法を教えてください。
Sub Outlook_mail_list() '''---コード1｜このコード内で使用する変数を宣言 Dim InboxFolder, i, n, k, attno As Long Dim sender, mes, path1 As String Dim outlookObj As Outlook.Application Dim myNameSpace, objmailItem As Object Dim fso 'As FileSystemObject '''---コード2｜定義した変数に必要な項目をセット Set outlookObj = CreateObject("Outlook.Application") Set myNameSpace = outlookObj.GetNamespace("MAPI") Set InboxFolder = myNameSpace.GetDefaultFolder(6) n = 2 '''---コード3｜メールの添付ファイルを保管するフォルダを作成 mes = InputBox("メールの添付資料を保管用フォルダを新しく作成します。フォルダ名を入力してください") path1 = ThisWorkbook.Path & "\" & mes Set fso = CreateObject("Scripting.FileSystemObject") fso.CreateFolder (path1) '''---コード4｜解析する受信メールの範囲を決める MsgBox InboxFolder.Items.Count For i = 1 To InboxFolder.Items.Count Set objmailItem = InboxFolder.Items(i) '''---コード5｜受信メールの件数、受信日時、件名(タイトル)、送信者名、送信元のメールアドレス、内容(本文)を取得 Range("A" & n).Value = i Range("B" & n).Value = objmailItem.ReceivedTime Range("C" & n).Value = objmailItem.Subject 'Range("D" & n).Value = objmailItem.SenderName 'Range("E" & n).Value = objmailItem.SenderEmailAddress 'Range("F" & n).Value = Left(objmailItem.Body, 100) コード
起こっている現象は何でしょうか？
Body等のプロパティが空？
> 原因はおそらく社内ネットワーク環境下での使用かと推測するのですが、
社外の環境では問題なかったということで良いでしょうか？
エラーの内容ですが、SenderNameが取得できない様子でコードが止まってしまいます。
社外環境での使用ができないため確認はできておらず、社内ネットワーク環境下でエラーが出てきます。 ただ他の方がこのvbaコードを試された結果は問題なく読み込みできるそうです。
> コードが止まってしまいます。
空が取れるのでなく、エラーでプログラムが途中で終了してしまうと言うことであれば、エラーメッセージを載せましょう。
回答2件
0
テスト実行してみた（仮に５件）、結果当方環境では取得できました。
office365,Outlook2019
多分Outlook内に受信しているメールに対して作業している？
社内メールの場合、送信者はよいが、送信者アドレスは
ここにあるようになりますね。
本文は、改行があると、セル高さ画面を超えた。
アドレスについて
ここでは肩書を検索されていますがAddressもあるかな？未確認
ExchangeUserのアッドレスの取得方法、OUTLOOK研究所様より
VBA
1Sub Outlook_mail_list() 2 3 '''---コード1｜このコード内で使用する変数を宣言 4 Dim InboxFolder, i, n, k, attno As Long 5 Dim sender, mes, path1 As String 6 Dim outlookObj As Outlook.Application 7 Dim myNameSpace, objmailItem As Object 8 Dim fso 'As FileSystemObject 9 10 '''---コード2｜定義した変数に必要な項目をセット 11 Set outlookObj = CreateObject("Outlook.Application") 12 Set myNameSpace = outlookObj.GetNamespace("MAPI") 13 Set InboxFolder = myNameSpace.GetDefaultFolder(6) 14 n = 2 15 16 '''---コード4｜解析する受信メールの範囲を決める 17 MsgBox InboxFolder.Items.Count 18 For i = 1 To 5 'InboxFolder.Items.Count 19 Set objmailItem = InboxFolder.Items(i) 20’＝＝＝＝＝＝＝＝＝＝＝追記 21 ' 差出人のアドレスを取得 22 strSenderAddr = objmailItem.SenderEmailAddress 23 If objmailItem.SenderEmailType = "EX" Then 24 ' 差出人のアドレス種別が Exchange なら ExchangeUser から取得 25 Set exchUser = objmailItem.sender.GetExchangeUser 26 strSenderAddr = exchUser.PrimarySmtpAddress 27 End If 28’＝＝＝＝＝＝＝＝＝＝＝ 29 n = i '仮に１メールごとに 30 '''---コード5｜受信メールの件数、受信日時、件名(タイトル)、送信者名、送信元のメールアドレス、内容(本文)を取得 31 Range("A" & n).Value = i 32 Range("B" & n).Value = objmailItem.ReceivedTime 33 Range("C" & n).Value = objmailItem.Subject 34 Range("D" & n).Value = objmailItem.SenderName 35 Range("E" & n).Value = strSenderAddr ’objmailItem.SenderEmailAddress 36 Range("F" & n).Value = Left(objmailItem.Body, 100) 37 Stop 38 Next 39End Sub 40
投稿2020/10/10 09:42
編集2020/10/12 06:34
総合スコア392
Teamsの会議メール（Class ＝ olMeetingRequest）にSenderがなく
エラーになってしまう。
会社PCで試してみます
実行時エラー -2147467529(80004005):
Sender EmailAdressメソッドは失敗しました_MailItemオブジェクト
というエラーが出てきます。デバックで確認すると
strSenderAddr = objmailItem.SenderEmailAddress
で止まっています。
考えられる対象方法をご教授願います。
0
ベストアンサー
質問者様
まず
VBA
1Range("F" & n).Value = Left(objmailItem.Body, 100)
のコメントだけを外したら正常に本文が取得できますか？
アドレスに関しては
[VBA]Outlook.MailItemから送信者のメールアドレスを取得する
にVBAがあります
VBA
1Range("E" & n).Value = GetSenderSMTPAddress(objmailItem)
のようにして試してください。
投稿2020/10/13 13:15
総合スコア2506
GetSenderSMTPAddressがハイライトして
コンパイルエラー
SubまたはFunctionが定義されていません
と出てきました
GetSenderSMTPAddressは参照先URLに記載があります。
その内容を「開発コンソール」の左側に「VBAProject」があるのでそこで右クリック
「挿入」→「標準モジュール」で追加(なにもなけれなModule1)
そこに参照先URLの「VBAに移植したコード」の内容をコピペして下さい。
はい追加した標準モジュールにコピペしました。
そのあとの作業がわかりません。何をすれば良いでしょうか
いえ、それで実行してみて下さい。
コピペが正しければ
>GetSenderSMTPAddressがハイライトして
>コンパイルエラー
>SubまたはFunctionが定義されていません
とは表示されなくなるはずです。
その前に
Range("F" & n).Value = Left(objmailItem.Body, 100)
は結果どうなったのですか？
Range("F" & n).Value = Left(objmailItem.Body, 100)をコメントアウトした結果は変わらずエラーが発生。
原因はその前の 'Range("D" & n).Value = objmailItem.SenderNameでとまります。
Range("C" & n).Value = objmailItem.Subjectまではきちんとエクセルに出力されるので、SenderName以降で何か問題があるのかと思われます。
'Range("D" & n).Value = objmailItem.SenderName
'Range("E" & n).Value = objmailItem.SenderEmailAddress
Range("F" & n).Value = Left(objmailItem.Body, 100)
まずコメントを外すのは最後の行だけ。その状態で実行してもらえませんか？
うまくいったら次に
'Range("E" & n).Value = objmailItem.SenderEmailAddress
を
Range("E" & n).Value = GetSenderSMTPAddress(objmailItem)
に書き換えて実行してみてくれませんか？
はいやってみました
Range("F" & n).Value = Left(objmailItem.Body, 100)を活動家して流すとアプリケーションエラーまたはオブジェクトエラーが返ってきます。 bodyも取得できないのが不思議です
> bodyも取得できないのが不思議です
その情報がほしくて何度も書きこんだんですが...
Outlookはメール用ソフトなんですが、企業とかバージョンによって仕様が違うんですね
特に企業用だとメール情報をふつうの所に書いていないので(セキュリティや仕組みの関係で)
取得できない場合があるんですよ今回みたいに...
(ウイルスみたいに勝手にメール情報取得できたら困るでしょ？)
bodyもGetSenderSMTPAddressみたいな方法を作らないといけないのですが、
正直企業用でOutlook使っている現場で確認しながら作らないと判断できないレベルです。
企業用環境ではセキュリティの関係で個人的にメール情報取得が困難ということを理解しました。
アドバイスいただきありがとうございます。
あなたの回答
tips
プレビュー
