0

エクセルでメールの送受信

BASP21.dllコンポーネントを利用して、エクセルでメールの送受信ができる。送信部分については送信リストを用いて一括配信するフォーマットにした。
メールの送信をVBAのsendmailメソッドでなく、BASP21.dllを使用した場合のメリットは、1.OLがインストールされていないPCでもメールを送信可能2.送信時にアラートがでない(また、OLのセキュリティの設定が不要)3.OEの「通常使用するメーラーに設定」等の設定が不要 4.メールの受信取り込みも可能、など。

メール一括送信

Sub smtp()
‘pop before smtpの処理
Dim Command As String, Folder As String, Para As String
Set objBsp = CreateObject(“Basp21”)
‘strSrv = “g3.mnx.ne.jp”
strSrv = Worksheets(“受信”).Range(“k5”).Value
strFrm = Worksheets(“受信”).Range(“k6”).Value

‘pop before smtp用
Server = Worksheets(“受信”).Range(“k2″).Value ”POP3サーバー
User = Worksheets(“受信”).Range(“k3″).Value ”アカウント名
Pass = Worksheets(“受信”).Range(“k4″).Value ”パスワード
Command = “STAT” ”コマンド
‘保存フォルダの確認(なければ作る)
With CreateObject(“Scripting.FileSystemObject”)
If Not .FolderExists(ThisWorkbook.Path & “mail”) Then
.CreateFolder ThisWorkbook.Path & “mail”
End If
End With
Folder = “<" & ThisWorkbook.Path & "mail" ''保存するフォルダ

'件名などを指定
Const END_ROW = 58
'!!!!配信リストの最終行を指定
For i = 9 To END_ROW
'mailto = "id1" & vbTab & "bcc" & vbTab & "id2"
'strAdd = maillist.Cells(i, 4)
'bccで自分宛におくる
strAdd = strNam & "” & vbTab & “bcc” & vbTab & maillist.Cells(7, 4)

strNam = maillist.Cells(i, 3)
strFlg = maillist.Cells(i, 2)

strSbj = maillist.Cells(i, 5) & “(” & maillist.Cells(7, 5) & “)”
strBdy = maillist.Cells(i, 6)
strFle = maillist.Cells(i, 7)
‘strFle = “c:tempfile1.txt” & vbTab & “c:tempb21xx.tmp|file2.txt”

If strFlg = “○” Then
If strAdd “” Then

Select Case CheckBox1.Value
Case True
‘popアクセス
ar = objBsp.RcvMail(Server, User, Pass, Command, Folder)
‘送信処理
‘strTo = strNam & “”
strTo = strAdd
lngRst = objBsp.SendMail(strSrv, strTo, strFrm, strSbj, strBdy, strFle)
Case False
‘送信処理
strTo = strNam & “”
lngRst = objBsp.SendMail(strSrv, strTo, strFrm, strSbj, strBdy, strFle)
End Select

End If
End If
Next

If rc “” Then ‘ エラーチェック
MsgBox rc, vbExclamation
Else
MsgBox (“メール送信完了”), vbInformation
End If

End Sub

メール受信

Sub pop() ”[受信]ボタン
Dim bobj, ar, Mail, retv
Dim Server As String, User As String, Pass As String
Dim Command As String, Folder As String, Para As String
Dim i As Long, cnt As Long
On Error Resume Next
Set bobj = CreateObject(“basp21″) ”BASP21オブジェクト
”BASP21がインストールされているかどうかを判定する
If Err = 429 Then
MsgBox “BASP21がインストールされていません。”, vbCritical
Exit Sub
End If
”必須データのチェック

Server = Worksheets(“受信”).Range(“k2″).Value ”POP3サーバー
User = Worksheets(“受信”).Range(“k3″).Value ”アカウント名
Pass = Worksheets(“受信”).Range(“k4″).Value ”パスワード
Command = “SAVEALL” ”コマンド
”保存フォルダの確認(なければ作る)
With CreateObject(“Scripting.FileSystemObject”)
If Not .FolderExists(ThisWorkbook.Path & “mail”) Then
.CreateFolder ThisWorkbook.Path & “mail”
End If
End With
Folder = “<" & ThisWorkbook.Path & "mail" ''保存するフォルダ

ar = bobj.RcvMail(Server, User, Pass, Command, Folder)
If IsArray(ar) Then
Para = "from:subject:"
For Each Mail In ar
retv = bobj.ReadMail(Mail, Para, Folder)
If Not IsArray(retv) Then
MsgBox "メールの受信に失敗しました"
Else
Worksheets("受信").Range("b65536").End(xlUp).Offset(1, 0) = retv(0) ''From
Worksheets("受信").Range("c65536").End(xlUp).Offset(1, 0) = retv(1) ''Subject
Worksheets("受信").Range("d65536").End(xlUp).Offset(1, 0) = retv(2) ''Body
End If
Next Mail
Else
MsgBox "新着メールはありません"
End If
Set bobj = Nothing

Worksheets("受信").Activate
Worksheets("受信").Range("a2:a2000").Select
Selection.RowHeight = 15

Worksheets("受信").Columns("B:B").Select
Selection.Replace What:="From: ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Worksheets("受信").Columns("C:C").Select
Selection.Replace What:="Subject: ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Worksheets("受信").Columns("D:D").Select
Selection.Replace What:="Body: ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Worksheets("maillist").Activate

End Sub


Leave a reply

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>