Excel VBAでメールを受信し読む｜本文・添付ファイルをセル表示
メールを受信し、メールのヘッダーと本文をセルに表示するExcel VBAを掲載しています。
Homeに戻る > Excel 数値・文字列・検索・印刷のTipsへ
Excelで顧客名簿などからメールを送信する場合は多いかと思いますが、受信することはあまりないかと思います。
ただビジネスの定期メールや異常メールなどの受信や、設備からの稼働状況などを受信できるとそのままデータとして記録しグラフ化するなどできるので大変便利です。
ここではPOPサーバー・アカウント・パスワードなどを入力したセルのデータで受診し、受信したメールのヘッダー・本文・添付ファイルをセルに表示するVBAを作成しました。
今回、Excel VBAでメール受信するにはTatsuo Babaさん作成のBSMTP.DLLを使用させていただきました。
BSMTP.DLLの著作権はTatsuo Babaさんが所有されています。
BSMTP.DLLはここよりダウンロードできます。
ダウンロード後、システムフォルダ(windows\system32)においてください。
ファイル読み込み関連の記事「Excel VBAでメールをすぐに送信する｜ボタンで送信するシート」を掲載しています参照してください。
メールを受信し読むVBA
Excel VBA コード
VBAコードの解説
受信用のライブラリRcvMailを宣言
メールを開くライブラリReadMailを宣言
ExMailReadファンクション プロシージャー
- メール受信のファイル名を変数に代入
- 添付ファイルが保存されるディレクトリ名をセルから変数に代入
- ヘッダーから読む項目の指定を変数に代入
- メールを開くライブラリReadMailの実行
- 読み込んだメールデータは配列に記録されているので、配列内のデータを順にセルに表示する
ExRecvMailプロシージャー
- 受信メールサーバー名が入力されているセルから変数に代入
- メールアカウントが入力されているセルから変数に代入
- パスワードが入力されているセルから変数に代入
- 受信数はSAVEALLで全て受信するようにセット
- 受信したメールの保存先フォルダが入力されているセルから変数に代入
- 受信用のライブラリRcvMailを実行 受信したメールファイルは配列に記録されているので、配列内のデータを順にセルに表示する
- ExMailReadファンクション プロシージャーでメールファイルを開き表示する
- もし受信が失敗した場合、エラーメッセージを表示
コマンドボタンのクリックイベント
- ExRecvMailプロシージャーの実行
Option Explicit
Private Declare Function RcvMail Lib "bsmtp" _
(szServer As String, szUser As String, szPass As String, szCommand As String, szDir As String) As Variant
Private Declare Function ReadMail Lib "bsmtp" _
(szFilename As String, szPara As String, szDir As String) As Variant
'メールを読む
Private Function ExMailRead(lrow As Long, sfina As String) As Long
Dim szFilename As String
Dim szPara As String
Dim szDir As String
Dim retva As Variant
Dim vr As Variant
'メール受信のファイル名
szFilename = sfina
'添付ファイルが保存されるディレクトリ
szDir = Range("F6")
'読むヘッダーの項目
szPara = "subject:from:date:"
retva = ReadMail(szFilename, szPara, szDir)
If IsArray(retva) Then
For Each vr In retva
'内容を表示
Range("F" & lrow) = vr
lrow = lrow + 1
Next
Else
Range("F" & lrow) = vr
End If
lrow = lrow + 1
'行を返す
ExMailRead = lrow
End Function
Private Sub ExRecvMail()
Dim szServer As String
Dim szUser As String
Dim szPass As String
Dim szCommand As String
Dim szDir As String
Dim aret As Variant
Dim va As Variant
Dim n As Long
szServer = Range("F3") '受信メールサーバー名
szUser = Range("F4") 'メールアカウント
szPass = Range("F5") 'パスワード
szCommand = "SAVEALL" '受信数 SAVEALLで全て受信
szDir = Range("F6") '受信したメールの保存先フォルダ
'受信実行
aret = RcvMail(szServer, szUser, szPass, szCommand, szDir)
n = 8 '受信したメールファイル名の表示開始行
If IsArray(aret) Then '正常終了の場合、戻り値は配列になる
For Each va In aret
Range("E" & n) = "受信ファイル："
'メールファイル名を表示
Range("F" & n) = va
'メールを読む
n = ExMailRead(n + 1, Range("F" & n))
Next
Else
Range("F" & n) = aret 'エラーの場合はメッセージを表示
End If
End Sub
Private Sub CommandButton1_Click()
ExRecvMail
End Sub
Private Declare Function RcvMail Lib "bsmtp" _
(szServer As String, szUser As String, szPass As String, szCommand As String, szDir As String) As Variant
Private Declare Function ReadMail Lib "bsmtp" _
(szFilename As String, szPara As String, szDir As String) As Variant
'メールを読む
Private Function ExMailRead(lrow As Long, sfina As String) As Long
Dim szFilename As String
Dim szPara As String
Dim szDir As String
Dim retva As Variant
Dim vr As Variant
'メール受信のファイル名
szFilename = sfina
'添付ファイルが保存されるディレクトリ
szDir = Range("F6")
'読むヘッダーの項目
szPara = "subject:from:date:"
retva = ReadMail(szFilename, szPara, szDir)
If IsArray(retva) Then
For Each vr In retva
'内容を表示
Range("F" & lrow) = vr
lrow = lrow + 1
Next
Else
Range("F" & lrow) = vr
End If
lrow = lrow + 1
'行を返す
ExMailRead = lrow
End Function
Private Sub ExRecvMail()
Dim szServer As String
Dim szUser As String
Dim szPass As String
Dim szCommand As String
Dim szDir As String
Dim aret As Variant
Dim va As Variant
Dim n As Long
szServer = Range("F3") '受信メールサーバー名
szUser = Range("F4") 'メールアカウント
szPass = Range("F5") 'パスワード
szCommand = "SAVEALL" '受信数 SAVEALLで全て受信
szDir = Range("F6") '受信したメールの保存先フォルダ
'受信実行
aret = RcvMail(szServer, szUser, szPass, szCommand, szDir)
n = 8 '受信したメールファイル名の表示開始行
If IsArray(aret) Then '正常終了の場合、戻り値は配列になる
For Each va In aret
Range("E" & n) = "受信ファイル："
'メールファイル名を表示
Range("F" & n) = va
'メールを読む
n = ExMailRead(n + 1, Range("F" & n))
Next
Else
Range("F" & n) = aret 'エラーの場合はメッセージを表示
End If
End Sub
Private Sub CommandButton1_Click()
ExRecvMail
End Sub
Excelシート画面
「メール受信」ボタンをクリックすると、メールを受信し、そのファイルが読み込まれ、内容が表示されます。
読む項目は、「Subject」「From」「Date」「本文」「添付ファイル」になります。
Homeに戻る > Excel 数値・文字列・検索・印刷のTipsへ
■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します
Copyright (c) Excel-Excel ! All rights reserved