回答編集履歴

1

追加、修正

2020/10/12 06:34

投稿

sinzou
sinzou

スコア392

test CHANGED
@@ -16,9 +16,9 @@
16
16
 
17
17
  アドレスについて
18
18
 
19
- [ここ](https://qiita.com/Q11Q/items/451018c20469f3861149)では肩書を検索されていますがAddressもあるかな?未確認
19
+ [ここ](https://qiita.com/Q11Q/items/451018c20469f3861149)~~では肩書を検索されていますがAddressもあるかな?未確認~~
20
20
 
21
-
21
+ ExchangeUserのアッドレスの取得方法、[OUTLOOK研究所](https://outlooklab.wordpress.com/)様より
22
22
 
23
23
  ```VBA
24
24
 
@@ -60,7 +60,23 @@
60
60
 
61
61
  Set objmailItem = InboxFolder.Items(i)
62
62
 
63
+ ’===========追記
63
64
 
65
+     ' 差出人のアドレスを取得
66
+
67
+ strSenderAddr = objmailItem.SenderEmailAddress
68
+
69
+ If objmailItem.SenderEmailType = "EX" Then
70
+
71
+ ' 差出人のアドレス種別が Exchange なら ExchangeUser から取得
72
+
73
+ Set exchUser = objmailItem.sender.GetExchangeUser
74
+
75
+ strSenderAddr = exchUser.PrimarySmtpAddress
76
+
77
+ End If
78
+
79
+ ’===========
64
80
 
65
81
  n = i '仮に1メールごとに
66
82
 
@@ -74,7 +90,7 @@
74
90
 
75
91
  Range("D" & n).Value = objmailItem.SenderName
76
92
 
77
- Range("E" & n).Value = objmailItem.SenderEmailAddress
93
+ Range("E" & n).Value = strSenderAddr ’objmailItem.SenderEmailAddress
78
94
 
79
95
  Range("F" & n).Value = Left(objmailItem.Body, 100)
80
96