•   Login
  •  
  •   Rss
  •   Rss2.0
  •   ATOM1.0
  •   Admin
  •   Top
  •   Home

Outlook VBAを作ってみた
 今秋のある日の阪急電鉄梅田駅。
最近、迷惑メール関係でメール送信事業者に送るたびに、送信者のメアドと受信日時とメール本文をコピペするのが面倒くさいので、次のサイトを参考に自分なりに作ってみました。(殆どコピペ+αなんですが…)
◆Outlook VBA(Outlookメール情報をExcel一覧化) 好きなものあれこれ
Outlook からメールヘッダの情報を収集する(1) ちょさかのひとりごと
Sub 選択メールの情報をExcel出力()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String, a As String
Dim Files As Variant, oF As Variant
Dim myExlApp As Object, oNewWb As Object, oSel As Object
Dim i As Integer, j As Integer
Dim lSubject As String
Dim lMsg As String
Dim lSentOnBehalfOfName As String
Dim lSenderName As String
Dim lReplyRecipientNames As String
Dim lFrom As String
Dim lTo As String
Dim lCreationTime As String
Dim lHeader As String

Set myOlApp = CreateObject("Outlook.Application")
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'新規ブック作成
Set myExlApp = CreateObject("excel.Application")
Set oNewWb = myExlApp.workbooks.Add
'一覧整形
myExlApp.ActiveWindow.Zoom = 85
With oNewWb.sheets(1)
.Cells.WrapText = True

.Range("A1:I1") = Array("件名", "受信日時", "送信者表示名", _
"送信者", "", "FROM", "TO", "内容", "ヘッダー")
.Columns("A:A").ColumnWidth = 50
.Columns("B:B").ColumnWidth = 18
.Columns("C:C").ColumnWidth = 30
.Columns("D:D").ColumnWidth = 30
.Columns("F:F").ColumnWidth = 30
.Columns("G:G").ColumnWidth = 30
.Columns("H:H").ColumnWidth = 100
.Columns("I:I").ColumnWidth = 100
.Rows("2:2").Select
End With
myExlApp.ActiveWindow.FreezePanes = True
With oNewWb.sheets(1)
.Range("A1").Select
End With

i = 1
'選択されているメールの添付ファイルを保存
For Each oSel In myOlSel

lSubject = oSel.Subject '---件名
lCreationTime = oSel.ReceivedTime '---受信日時
lSentOnBehalfOfName = oSel.SentOnBehalfOfName '---送信者表示名
lSenderName = oSel.SenderName '---送信者
lReplyRecipientNames = oSel.ReplyRecipientNames '---返信先メールアドレス
lFrom = oSel.SenderEmailAddress '---送信者メールアドレス
lTo = oSel.To '---宛先メールアドレス
lMsg = oSel.Body '---メール本文
'---PropertyAccessor クラスのインスタンスを取得します。
PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Set oPA = oSel.PropertyAccessor

lHeader = oPA.GetProperty(PropName) '---ヘッダー

i = i + 1

oNewWb.sheets(1).Cells(i, 1).Value = lSubject
oNewWb.sheets(1).Cells(i, 2).Value = lCreationTime
oNewWb.sheets(1).Cells(i, 3).Value = lSentOnBehalfOfName
oNewWb.sheets(1).Cells(i, 4).Value = lSenderName
oNewWb.sheets(1).Cells(i, 5).Value = lReplyRecipientNames
oNewWb.sheets(1).Cells(i, 6).Value = lFrom
oNewWb.sheets(1).Cells(i, 7).Value = lTo
oNewWb.sheets(1).Cells(i, 8).Value = lMsg
oNewWb.sheets(1).Cells(i, 9).Value = lHeader

Next

myExlApp.Visible = True

p_Error:
Set oF = Nothing
Set oSel = Nothing
Set myExlApp = Nothing
Set oNewWb = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
MsgBox "終了しました。総数:" & i - 1
End Sub

Outlook2010で検証したのですが、バッチリ取得出来ました。
これで何がどうなるかというと、選択(複数も可能)したメールから「件名」「受信日時」「送信者表示名」「送信者」「返信先メールアドレス」「送信者メールアドレス」「宛先メールアドレス」「メール本文」「ヘッダー」を吸い出します。(本家本元は、他にも添付ファイル等の情報も吸い出します。)


Outlookなら簡単に出来ますね。このサイトを公開してくれた方に感謝感謝です。
これで、手軽にどんどん迷惑メールを公開してやろうと思います。
Thunderbirdからも簡単に出来るなら、ちょっとチャレンジしてみましょうかね。

記事を評価してください(★1つ=悪い、★5つ=良い)
この記事の平均評価: (1人)
Posted by いぐぅ 19:56 | ソフトウェア::プログラミング | comments (0) | trackback (0)
コメント
コメントする









この記事のトラックバックURL
http://www.sir-2.net/dablg/tb.php/5243
トラックバック

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31