| |
こんにちは。かみちゃん です。
>メールサーバにメールを読みにいって、そのメールをエクセルに落としたい
[#20447]の私の発言を参考にしていただきありがとうございます。
私もメールデータをExcelに取り込むことをしていますが、概ね以下のような
感じでできると思います。
（BSMTP.DLLを使用していますので、BSMTP.DLLをインストールしてあることが前提
で、一応、動作確認はしてあります。）
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
Sub Macro1()
'------------------------------------------------------------
'メールを受信する
'------------------------------------------------------------
Dim szServer As String, szUser As String, szPass As String
Dim szCommand As String, szDir As String
Dim ar As Variant, v As Variant
Dim szFilename As String, szPara As String
Dim retv As Variant, v2 As Variant
szServer = "your pop3 server" 'SMTPサーバ名と同じでよい。
'タブで区切ってポート番号を指定できます。
szUser = "your-name" 'メールアカウント名
szPass = "pass" 'パスワード
' 2000/05/20 APOPをサポート
' APOP 認証をするには、パスワードの前に "a" または "A" に １個の
' ブランクをつけます｡
' "a xxxx" : サーバがAPOP 未対応なら通常のUSER/PASS 処理をします。
' "A xxxx" : サーバがAPOP 未対応ならエラーになります。
szCommand = "SAVE 1-3" 'コマンド メールの１件目から３件目までを受信
' szDir = "c:\maildata" '受信したメールを保存するディレクトリ
szDir = ThisWorkbook.Path 'このマクロと同じフォルダに保存する。
ar = RcvMail(szServer, szUser, szPass, szCommand, szDir)
'戻り値が返る変数は、Variantタイプを指定すること。
'受信したメール１通ごとにファイルが作成されます。
'メールに添付されたファイルは、本文と共に１つのファイルに含まれます。
'ReadMail関数で添付ファイルを取出します。
If IsArray(ar) Then '正常終了時のSAVEコマンドの戻り値は、配列になります。
For Each v In ar
' Debug.Print v 'メールデータが保存されたファイル名がフルパスで戻ります。
'このファイル名をReadMailのパラメータとして渡します。
'------------------------------------------------------------
'ReadMail関数を使ってメールの内容を読む
'------------------------------------------------------------
szFilename = v ' ファイル名にはRcvMailの戻り値の配列からファイル名を設定
szPara = "subject:from:date:" ' ヘッダーの指定
' nofile: とすると添付ファイルを保存しません。
retv = ReadMail(szFilename, szPara, szDir)
If IsArray(retv) Then
For Each v2 In retv
' Debug.Print v2
Range("A65536").End(xlUp).Offset(1).Value = v2
Next
Else
' Debug.Print retv
MsgBox "retv=" & retv
End If
Next
Else
' Debug.Print ar 'エラー発生時は、配列でなくメッセージが戻ります。
MsgBox "ar=" & ar 'エラー発生時は、配列でなくメッセージが戻ります。
End If
MsgBox "終了しました"
End Sub
このコードだけでは、たぶん、本当にしたいことはできないかもしれませんが、
何かわからないことがあれば、聞いてください。
|
|
かみちゃん
- 06/7/5(水) 7:25 -
