Search

  毎日にもっと楽~を! BLOG Tokyo

2008年9月 9日

【Outlook】添付ファイルを一括保存する

Excelで作ったアンケートフォームをメールの添付ファイルで返信してもらい集計する。添付ファイルを毎回保存するのって結構面倒くさい。選択したメールから一括で保存する方法はないだろうか。

ThundirbirdはAttachment Extractorというアドオンで簡単にできる。

しかし、Outlookは便利なアドオンを見つけることも労を要する。

Outlookの公式ページ

いろいろ探した結果、添付ファイルを一括保存するVBAを公開しているブログがあったので、そちらを参考にさせてもらいました。なかなか便利で気に入っています。


せっかくなので、ツールバーのコマンドをカスタマイズすると便利です。


Outlook2003, Windows XPの環境で動作確認済み。


ツール -> マクロ -> visual basic editor ->挿入 ->標準モジュール
に下記をコピペで動作すると思います。

'アクティブウィンドウハンドルを取得する
Private Declare Function GetActiveWindow Lib "USER32" () As Long
'ウィンドウタイトル取得
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hWnd&, ByVal lpString$, ByVal cch&) As Long
''ウィンドウタイトル変更
Private Declare Function SetWindowText Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long


Sub 選択メールの添付ファイルを指定フォルダに一括保存()
Dim cDir As String, oSel As Object, oF As Object
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim mySendFolder As Outlook.MailItem
Dim myCopiedItem As Outlook.Items
Dim lMax As Integer, i As Integer
Dim MyTitle As String
Dim Leng As Long, hWnd As Long, ret As Long

Dim myAttachments As Outlook.Attachment
Dim MsgTxt As String, a As String
Dim myExlApp As Object, Files As Object
Dim lSubject As String

On Error Resume Next
Set myOlApp = CreateObject("Outlook.Application")
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

Set myExlApp = CreateObject("excel.Application")
cDir = myExlApp.GetSaveAsFilename("DUMMY", "全ファイル(*.*),*.*", , "保存先フォルダ指定")
If cDir = "False" Or cDir = "FALSE" Then GoTo p_exit

cDir = Mid(cDir, 1, InStrRev(cDir, "\") - 1)

'現在のウィンドウタイトル取得
hWnd = GetActiveWindow()
MyTitle = String(250, Chr(10))
Leng = Len(MyTitle)
ret = GetWindowText(hWnd, MyTitle, Leng)

'選択されたメールの添付ファイルを保存
For Each oSel In myOlSel
i = i + 1
ret = SetWindowText(hWnd, oSel & "(" & i & "/" & myOlSel.Count & ")" & "を処理中...")
For Each oF In oSel.Attachments
oF.SaveAsFile cDir & "\" & oF.DisplayName
Next

Next

ret = SetWindowText(hWnd, MyTitle)
MsgBox "終了しました。総数:" & i
ret = Shell("c:\windows\explorer.exe " & cDir, vbNormalFocus)

p_exit:
Set myExlApp = Nothing
Set oSel = Nothing
Set oF = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub


出典:「好きなものあれこれ」
Outlook VBA(複数メールの添付ファイルを一括保存)

その後の集計作業で、シートを分割して、分類別仕分け、分類ごとに同一ブックにしたら効率的に集計作業に移れそうな気がする。過去のエントリーで紹介済みなので、併せて使うと便利かと思います。


【エクセル】複数のシートをブックに分割

【エクセル】複数のシートを1枚にまとめる

【Excel】アンケートフォームの作成






Bookmark and Share


編集長のおすすめの一冊!2010

comments

comment form

(BLOG Tokyo にはじめてコメントされる場合、不適切なコメントを防止するため、掲載前に管理者が内容を確認しています。適切なコメントと判断した場合コメントは直ちに表示されますので、再度コメントを投稿する必要はありません。)

comment form