Public LastChecked As Date
Public LastSaved As Boolean
Public CheckPeriod As Integer

Private Sub Timer1_Timer()
Dim X As Integer
Dim Completed As Boolean
    On Error GoTo errh
    Completed = True
    For X =  0  To UBound(m_States)
        With m_States(X)
            If .State = POP3_VeryQUIT And .RETR =  0  Then
                If Not .Stored And Not .Error Then
                    .Stored = True
                End If
            End If
            Completed = Completed And (.Stored Or .Error) And .State = POP3_VeryQUIT
        End With
    Next
    If Not LastSaved And Completed Then
        SaveSetting App.Title, "Common", "LastChecked", LastChecked
        LastSaved = True
    End If
    If DateDiff("n", LastChecked, Now) >= Val(CheckPeriod) And Completed Then
        LastChecked = Now
        LastSaved = False
        InitStates True
        For X =  0  To UBound(m_States)
            Debug.Print X; "Connecting " & m_States(X).Server, "##################################################"
            Select Case m_States(X).Protocol
                Case pSMTP: Winsock1(X).Connect m_States(X).Server,  110 
                Case pIMAP: Winsock1(X).Connect m_States(X).Server,  143 
            End Select
        Next
    End If
    Exit Sub
errh:
    'frmReport.AddEvent "Timer - " & Err.Description, etError
    Debug.Print "Timer - " & Err.Description
    Exit Sub
    Resume
End Sub

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Select Case m_States(Index).Protocol
        Case pSMTP: DataArrivalSMTP Winsock1(Index), bytesTotal
        Case pIMAP: DataArrivalIMAP Winsock1(Index), bytesTotal
    End Select
End Sub

Private Sub Winsock1_Error(Index As Integer, 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)
    m_States(Index).Error = True
    m_States(Index).State = POP3_VeryQUIT
    Winsock1(Index).Close
End Sub

Private Sub InitStates(Init4Work As Boolean)
Dim rs As ADODB.Recordset
Dim X As Integer, Y As Integer
    On Error Resume Next
    If Not OpenAccounts Then Exit Sub
    ReDim m_States(rsAccounts.RecordCount -  1 )
    While Not rsAccounts.EOF
        If Init4Work Then
            If X >  0  Then Load Winsock1(X)
            Winsock1(X).Close
            Winsock1(X).LocalPort =  0 
            Set rs = New ADODB.Recordset
            rs.Open "select * from Deleted where 1=2", cn, adOpenStatic, adLockBatchOptimistic
            Set m_States(X).RsDeleted = rs
            Set rs = Nothing
            m_States(X).State = POP3_Connect
        Else
            m_States(X).State = POP3_VeryQUIT
            m_States(X).Stored = True
        End If
        m_States(X).Protocol = rsAccounts!Type
        m_States(X).Login = rsAccounts!Login
        m_States(X).Pass = rsAccounts!Pass
        m_States(X).Account = rsAccounts!email
        m_States(X).AccountID = rsAccounts!AccountID
        m_States(X).Server = rsAccounts!Server
        rsAccounts.MoveNext
        X = X +  1 
    Wend
    For X =  1  To  4 
        If StaSave(X) Then Y = Y +  1 
    Next
    FastMode = Y /  2  <=  2 
End Sub

Public Enum POP3States
    POP3_Connect =  1 
    POP3_USER =  2 
    POP3_PASS =  3 
    POP3_STAT =  4 
    POP3_TOP =  5 
    POP3_DELE =  6 
    POP3_QUIT =  7 
    POP3_LIST =  8 
    POP3_VeryQUIT =  9 
    IMAP_EXPUNGE =  10 
    IMAP_COPY =  11 
    POP3_RETR =  12 
End Enum

Public Type WSState
    State As POP3States
    StateStat As Boolean
    AccountID As Long
    SpamCount As Integer
    MailCount As Integer
    MessagesCount As Integer
    Protocol As Proto
    Login As String
    Pass As String
    CurrentMsg As Integer
    BufferString As String
    IMAPStep As Integer
    Stored As Boolean
    Error As Boolean
    Account As String
    IMAPMsgs() As String
    RsDeleted As ADODB.Recordset
    RETR As Long
    Server As String
End Type

Public m_States() As WSState
Public FastMode As Boolean

Public Sub DataArrivalSMTP(Winsock1 As Winsock, ByVal bytesTotal As Long)
Dim m_oMessage As CMessage
Dim strData As String
Dim s As String
    On Error GoTo errh
    Winsock1.GetData strData
    With m_States(Winsock1.Index)
        'Debug.Print Winsock1.Index, strData
        If Left$(strData,  1 ) = "+" Or .State = POP3_TOP Or .State = POP3_RETR Then
            Select Case .State
                Case POP3_Connect
                    .MessagesCount =  0 
                    .State = POP3_USER
                    Winsock1.SendData "USER " & .Login & vbCrLf
                Case POP3_USER
                    .State = POP3_PASS
                    Winsock1.SendData "PASS " & .Pass & vbCrLf
                Case POP3_PASS
                    .State = POP3_STAT
                    Winsock1.SendData "STAT" & vbCrLf
                    Debug.Print Winsock1.Index; ">STAT"
                Case POP3_STAT
                    .MessagesCount = CInt(Mid$(strData,  5 , InStr( 5 , strData, " ") -  5 ))
                    If Not .StateStat Then
                        If .MessagesCount >  0  Then
                            .CurrentMsg =  1  '.MessagesCount
                            .MailCount = .MessagesCount
                            If FastMode Then
                                .State = POP3_TOP
                                Winsock1.SendData "TOP " & .CurrentMsg & " 0" & vbCrLf
                            Else
                                .State = POP3_RETR
                                Winsock1.SendData "RETR " & .CurrentMsg & vbCrLf
                            End If
                        Else
                            .MailCount =  0 
                            .State = POP3_QUIT
                            Winsock1.SendData "QUIT" & vbCrLf
                            .SpamCount =  0 
                        End If
                    Else
                        .SpamCount = .MailCount - .MessagesCount
                        .State = POP3_QUIT
                        Winsock1.SendData "QUIT" & vbCrLf
                    End If
                Case POP3_TOP, POP3_RETR
                    .BufferString = .BufferString & strData
                    If InStr( 1 , .BufferString, vbLf & "." & vbCrLf) Then
                        If InStr(.BufferString, "+") =  1  Then .BufferString = Mid$(.BufferString, InStr(.BufferString, vbCrLf) +  2 )
                        .BufferString = Left$(.BufferString, Len(.BufferString) -  3 )
                        Set m_oMessage = New CMessage
                        m_oMessage.AccountID = .AccountID
                        m_oMessage.Account = .Account
                        m_oMessage.CreateFromText .BufferString
                        'Debug.Print Winsock1.Index & " " & .CurrentMsg, m_oMessage.FromEmail, m_oMessage.FromName, m_oMessage.Subject
                        'Debug.Print .BufferString
                        'Debug.Print Winsock1.Index, m_oMessage.SendDate, m_oMessage.FromEmail
                        s = CheckMsg(m_oMessage, Winsock1.Index)
                        If .RETR <>  0  Then .RETR =  0 
                        Winsock1.SendData s
                    End If
                Case POP3_QUIT
                    Winsock1.Close
                    .State = POP3_VeryQUIT
                Case POP3_DELE
                    .CurrentMsg = .CurrentMsg +  1 
                    .BufferString = ""
                    If .CurrentMsg > .MessagesCount Then
                        .StateStat = True
                        .State = POP3_STAT
                        Winsock1.SendData "STAT" & vbCrLf
                    Else
                        If FastMode Then
                            .State = POP3_TOP
                            Winsock1.SendData "TOP " & .CurrentMsg & " 0" & vbCrLf
                        Else
                            .State = POP3_RETR
                            Winsock1.SendData "RETR " & .CurrentMsg & vbCrLf
                        End If
                    End If
            End Select
        Else
            Winsock1.SendData "QUIT" & vbCrLf
            .State = POP3_QUIT
            .Error = True
        End If
    End With
    Exit Sub
errh:
    With m_States(Winsock1.Index)
        frmReport.ctlProgress1.ErrDesc(Winsock1.Index) = LoadEnumString(, "ProgramError") & "DataArrivalSMTP - " & Err.Description
        Winsock1.Close
        Debug.Print Err.Description
        .State = POP3_VeryQUIT
        .Error = True
    End With
    Exit Sub
    Resume
End Sub

Option Explicit
Private m_strMessageText     As String
Private m_strMessageBody     As String
Private m_strHeaders         As String

Dim lCDOMessage As New CDO.Message

Public Sub CreateFromText(strMessage As String)
Dim st As ADODB.Stream
Dim X As Integer
    m_strMessageBody = strMessage
    X = InStr(m_strMessageBody, vbCrLf & vbCrLf)
    If X <>  0  Then
        m_strHeaders = Mid$(strMessage,  1 , X -  1 )
        m_strMessageText = Mid$(strMessage, X +  4 )
    Else
        m_strHeaders = strMessage
    End If
    
    Set st = lCDOMessage.GetStream
    st.Type = adTypeText
    st.WriteText strMessage
    st.Flush
End Sub

Public Property Get FromName() As String
    FromName = lCDOMessage.Fields("urn:schemas:httpmail:fromname").Value
End Property

Public Property Get FromEmail() As String
    FromEmail = Replace(Replace(lCDOMessage.Fields("urn:schemas:httpmail:fromemail").Value, "<", ""), ">", "")
End Property

Public Property Get Headers() As String
    Headers = m_strHeaders
End Property

Public Property Get MessageText() As String
    MessageText = m_strMessageText
End Property

Public Property Get Subject() As String
    Subject = lCDOMessage.Subject
End Property

Public Property Get OtherCount() As Integer
    OtherCount = lCDOMessage.Fields.Count
End Property

Public Property Get OtherFields(Index As Integer) As ADODB.Fields
    Set OtherFields = lCDOMessage.Fields
End Property

Public Property Get MessageTo() As String
Dim r As String
Dim X As Integer
    r = lCDOMessage.Fields("urn:schemas:mailheader:to").Value
    X = InStr(r, "<")
    If X <>  0  Then
        r = Mid(r, X +  1 , InStr(X, r, ">") - X -  1 )
        MessageTo = r
    End If
End Property

Public Property Get SendDate() As String
    SendDate = lCDOMessage.ReceivedTime
End Property

Public Property Get Size() As Long
    Size = Len(m_strMessageBody)
End Property

        If m_oMessage.Deleted Then
            .State = POP3_DELE
            CheckMsg = "DELE " & .CurrentMsg & vbCrLf
        Else
skip:
            If .CurrentMsg = .MessagesCount Then
                .StateStat = True
                .State = POP3_STAT
                CheckMsg = "STAT" & vbCrLf
            Else
                .CurrentMsg = .CurrentMsg +  1 
                If FastMode Then
                    .State = POP3_TOP
                    CheckMsg = "TOP " & .CurrentMsg & " 0" & vbCrLf
                Else
                    .State = POP3_RETR
                    CheckMsg = "RETR " & .CurrentMsg & vbCrLf
                End If
            End If
        End If
        .BufferString = ""