受信したメールに添付された Excel ファイルをもとに別の Excel ファイルの内容を更新するマクロ


コメントにて以下のご要望をいただきました。


お世話になります。
いつも当該サイトのコードを参考して頂いており、大変感謝致します。
さて、最近下記の様な自動処理マクロを考えておりますが、ご協力を頂きたくお願い致します。
使用環境は Windows 7, Office Pro Plus 2010
毎日倉庫より納品された貨物の実寸報告のメールが数回に受信されます。
そのメールには、商品番号と商品梱包の三辺サイズが記載されたEXCELファイルが添付されております。
件名:サイズ報告
(EXCELファイルの例:)
A列 B列 C列 D列
品番1 幅1 横1 高1
品番2 幅2 横2 高2
そのメールが受信されましたら、自動的に商品マスターファイル(excel形式)の該当商品のサイズを
更新するよう、とのマクロを考えております。  
受信したEXCELファイルを一旦保存し、その後 EXCEL側でVBA処理するなら、
特に問題なくできましたが、OUTLOOK側で自動的処理するできるなら大変助かります。
何卒、アドバイスを頂けますようお願い致します。


メールが受信された際に何らかの自動処理を行うには Application オブジェクトの NewMailEx イベントを使用します。
そして、NewMailEx イベントの EntryIDCollection には受信したアイテムのエントリー ID が格納されていますので、これを引数として Session.GetItemFromID メソッドにより受信したメール アイテムを取得できます。
メール アイテムの添付ファイルを取得するには Attachments プロパティを使用し、Attachment オブジェクトの SaveAsFile メソッドでローカルに保存します。
保存した Excel ファイルで何か処理をする手順は Excel のマクロの記述と同じです。
マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     Dim objMail As Object
     ' 受信したアイテムを取得
     Set objMail = Session.GetItemFromID(EntryIDCollection)
     ' アイテムがメールであり、件名が "サイズ報告" なら処理を開始
     If TypeName(objMail) = "MailItem" And objMail.Subject = "サイズ報告" Then
         ReplaceMaster objMail
     End If
End Sub
' マスター ファイルを更新するサブ
Private Sub ReplaceMaster(ByVal objMail As MailItem)
     ' 商品マスター ファイルのフルパス
     Const MASTER_FILE = "c:\temp\master.xlsx"
     ' 添付ファイルを一時保存するフォルダー (最後に \ を付ける)
     Const TEMP_FOLDER = "c:\temp\"
     ' マスター ファイルの先頭行には列名が入っていると仮定
     Const START_ROW_MASTER = 2
     ' サイズ報告のファイルは 1 行目からデータと仮定
     Const START_ROW_REPORT = 1
     '
     Dim objAttach As Attachment
     Dim strReportXls As String
     Dim wbMaster As Object ' Excel.Workbook
     Dim wsMaster As Object ' Excel.Worksheet
     Dim wbReport As Object ' Excel.Workbook
     Dim wsReport As Object ' Excel.Worksheet
     Dim i As Integer
     Dim iRow As Integer
     ' 添付ファイルがなければ処理を中断
     If objMail.Attachments.Count = 0 Then
         Exit Sub
     End If
     ' 添付ファイルを取得
     Set objAttach = objMail.Attachments(1)
     With objAttach
         ' 添付ファイルが Excel ファイルなら一時フォルダーに保存
         If .FileName Like "*.xls" Or .FileName Like "*.xls?" Then
             strReportXls = TEMP_FOLDER & .FileName
             .SaveAsFile strReportXls
         Else
             ' 添付ファイルが Excel ファイルでなければ中断
             Exit Sub
         End If
     End With
     ' マスター ファイルを取得
     Set wbMaster = GetObject(MASTER_FILE)
     wbMaster.Windows(1).Activate
     Set wsMaster = wbMaster.Sheets(1)
     ' 一時ファイルを取得
     Set wbReport = GetObject(strReportXls)
     Set wsReport = wbReport.Sheets(1)
     '
     i = START_ROW_REPORT
     ' 一時ファイルの 1 列目 (品番) にデータがなくなるまで繰り返し
     While wsReport.Cells(i, 1) <> ""
         iRow = START_ROW_MASTER
         With wsMaster
             ' マスター ファイルの 1 列目 (品番) にデータがなくなるか、
             ' 一時ファイルの 1 列目と一致するまで繰り返し
             While .Cells(iRow, 1) <> "" And _
                   .Cells(iRow, 1) <> wsReport.Cells(i, 1)
                 ' 次の行に移動
                 iRow = iRow + 1
             Wend
             ' 品番が一致したら置き換え
             If .Cells(iRow, 1) <> "" Then
                 .Cells(iRow, 2) = wsReport.Cells(i, 2)
                 .Cells(iRow, 3) = wsReport.Cells(i, 3)
                 .Cells(iRow, 4) = wsReport.Cells(i, 4)
             End If
         End With
         ' 次の行に移動
         i = i + 1
     Wend
     ' 一時ファイルは保存せずに閉じる
     wbReport.Close False
     ' マスター ファイルは保存して閉じる
     wbMaster.Close True
     ' 一時ファイルを削除する
     Kill strReportXls
End Sub

マクロの登録方法やメニューへの追加について

広告

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中