回答編集履歴
1
追加、修正
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
|
|