[ Parse POP3 Message Header ]

				
'Includes: 

' Form: Name = form1 

' Winsock Control: Name = Winsock1 

'---------------------------------- 

Public prevCmd As String

Public mailServer As String 

Public username As String

Public password As String 

Private Sub Form_Load()

 prevCmd = ""

'Set your mailsever, username, and password

 mailServer = "mail.yourmailserver.net"

 username = "yourusername"

 password = "yourpassword"

'Connect to mail server

 winsock1.Connect mailServer, 110

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim data As String

'Get winsock data and find next command to send

 Select Case prevCmd

 Case "USER"

 'Send password

 winsock1.senddata "PASS " & password & vbCrLf

 prevCmd = "PASS"

 Case "PASS"

 'Send TOP 1 to get message header

 winsock1.senddata "TOP 1" & vbCrLf

 prevCmd = "TOP"

 Case "TOP"

 'Parse message

winsock1.getdata data 

 parseMSG (data)

 Case ""

 'Send username.

 winsock1.senddata "USER " & username & vbCrLf

 prevCmd = "USER"

 End Select

end sub 

Private Sub parseMSG(data As String)

'Get To, From, and subject

Dim dataHold As Variant 'Data Holder for Split function. Creates an array of lines

Dim epos As Long 'Ending Position for Mid function

Dim spos As Long 'Starting Position for Mid function

 'Split data where there are vbCrLf characters. Which is at the end of every line 

 dataHold = Split(data, vbCrLf)


 
 'Examine Each line of data

 For i = LBound(dataHold) To UBound(dataHold)

 If dataHold(i) <> "" Then 'If the line is not blank then

 'Selects the beginning of each line to see what info it contains

 Select Case UCase(Left(dataHold(i), InStr(1, dataHold(i), ":")))

 Case "FROM:" 'If its the sender

 spos = InStr(1, dataHold(i), ":") + 2 'Starting Position for Mid function

 epos = Len(dataHold(i)) - 1 'Ending Position for Mid function

 MsgBox Mid$(dataHold(i), spos, epos - spos + 2) 'Select the middle of the data, not including the beginning tag or the vbCrLf's

 Case "TO:" 'If its your email

 spos = InStr(1, dataHold(i), ":") + 2 'Starting Position for Mid function

 epos = Len(dataHold(i)) - 1 'Ending Position for Mid function

 MsgBox Mid$(dataHold(i), spos, epos - spos + 2) 'Select the middle of the data, not including the beginning tag or the vbCrLf's

 Case "SUBJECT:" 'If its the subject

 spos = InStr(1, dataHold(i), ":") + 2 'Starting Position for Mid function

 epos = Len(dataHold(i)) - 1 'Ending Position for Mid function

 MsgBox Mid$(dataHold(i), spos, epos - spos + 2) 'Select the middle of the data, not including the beginning tag or the vbCrLf's

 End Select

 End If

 Next i

End Sub