SMTP,POP3,VB6メール送受信
Winsock1コントロールを使ってメール送信、メール受信件数を取得します。
フォームに、Winsock1、テキストボックス２つ、ボタン２つ貼り付けて以下のコードで実行してください。
サーバアドレス、メールアドレスは自分のものを使用してください。
注意！ スパムメールなどには使用しないこと
Option Explicit
Private strBuff As String
Private Sub Command2_Click()
'送信
Dim strHost As String
Dim strDomain As String
Dim strFrom As String
Dim strFromName As String
Dim strTo As String
Dim strSubject As String
Dim strData As String
Dim stBody As String
strHost = "ＳＭＴＰメールサーバ"
strDomain = "貴方のＰＣ名"
strFrom = "貴方のメアド"
strTo = "あて先メアド"
strSubject = Text2.Text '件名
stBody = Text1.Text '内容
On Error GoTo SOS
With Winsock1
' .LocalPort = 1
.RemoteHost = strHost
.RemotePort = 25
.Protocol = sckTCPProtocol
.Connect
'接続の確立
Call CodeMatu("220")
.SendData "EHLO " & "mk" & vbCrLf
Call CodeMatu("250")
.SendData "MAIL FROM:" & strFrom & vbCrLf
Call CodeMatu("250")
.SendData "RCPT TO:" & strTo & vbCrLf
Call CodeMatu("250")
.SendData "DATA" & vbCrLf
Call CodeMatu("354")
strData = "From: ""testuser"" ＜" & strFrom & "＞" & vbCrLf & _
"To: ＜" & strTo & "＞" & vbCrLf & _
"Subject: " & strSubject & vbCrLf & _
"Date: " & Format(Now, "ddd, d mmm yyyy hh:mm:ss") & " +0900 (JST)" & vbCrLf & _
"MIME-Version: 1.0" & vbCrLf & _
"Content-Type: text/plain;" & vbCrLf & _
" format=flowed;" & vbCrLf & _
" charset=""iso-2022-jp"";" & vbCrLf & _
" reply-type=original" & vbCrLf & _
"Content-Transfer-Encoding: 7bit" & vbCrLf & _
"X-Priority: 3" & vbCrLf
.SendData strData & vbCrLf
.SendData stBody & vbCrLf
.SendData "." & vbCrLf
Call CodeMatu("250")
.SendData "QUIT " & vbCrLf
Call CodeMatu("221")
.Close
Do While .State ＜＞ sckClosed
DoEvents
Loop
End With
SOS:
Debug.Print Err.Description
End Sub
Private Sub Command3_Click()
''ＰＯＰ3接続
'1. ポート=110で，POP3サーバーと接続
'2. USERコマンド送信
'3. PASSコマンド送信
'4. STATコマンド送信
'5. RETRコマンド送信
'6. QUITコマンド送信
'7. POP3サーバーと切断
Dim strHost As String
strHost = "ＰＯＰ３サーバアドレス"
Dim strUser As String
strUser = "貴方のユーザＩＤ"
Dim strPass As String
strPass = "貴方のパスワード"
With Winsock1
.Close
.LocalPort = 0 '0にしないとエラー有り
.RemoteHost = strHost
.RemotePort = 110
.Protocol = sckTCPProtocol
.Connect
Call CodeMatu("+OK")
.SendData "USER " & strUser & vbCrLf
DoEvents
Call CodeMatu("+OK")
.SendData "PASS " & strPass & vbCrLf
DoEvents
Call CodeMatu("+OK")
.SendData "STAT" & vbCrLf
DoEvents
.SendData vbCrLf & "." & vbCrLf
Call CodeMatu("+OK")
.SendData "QUIT"
DoEvents
.Close
Debug.Print "ＰＯＰ3接続終了"
End With
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
Winsock1.Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData strBuff
Debug.Print strBuff
DoEvents
End Sub
Private Sub CodeMatu(ByVal StrCode As String)
Dim Start As Long
Dim Tmr As Long
Start = Timer
While Len(strBuff) = 0
Tmr = Start - Timer
DoEvents
If Tmr ＞ 50 Then
MsgBox "SMTP service error, timed out while waiting for response", 64, "MsgTitle"
Exit Sub
End If
Wend
While Left(strBuff, 3) ＜＞ StrCode
DoEvents
If Tmr ＞ 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + StrCode + " Code recieved: " + strBuff, 64, "MsgTitle"
Exit Sub
End If
Wend
strBuff = ""
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Debug.Print Number & Description
Debug.Print Scode
Debug.Print Source
Debug.Print HelpFile
Debug.Print HelpContext
Debug.Print CancelDisplay
End Sub
|
|