Search/Download only Encrypted Emails

Searching an IMAP mailbox for emails that are encrypted and download. Emails are automatically decrypted.

Download Chilkat IMAP ActiveX

Dim imap As New ChilkatImap

Dim success As Long

'  Anything unlocks the component and begins a fully-functional 30-day trial.
success = imap.UnlockComponent("Anything for 30-day trial")
If (success <> 1) Then
    MsgBox imap.LastErrorText
    Exit Sub
End If

'  Connect to an IMAP server.
success = imap.Connect("www.cknotes.com")
If (success <> 1) Then
    MsgBox imap.LastErrorText
    Exit Sub
End If

'  Login
success = imap.Login("myLogin","myPassword")
If (success <> 1) Then
    MsgBox imap.LastErrorText
    Exit Sub
End If

'  Select an IMAP mailbox
success = imap.SelectMailbox("Inbox")
If (success <> 1) Then
    MsgBox imap.LastErrorText
    Exit Sub
End If

'  An S/MIME encrypted email should have a content-type
'  header containing the substring "pkcs7-mime":
Dim headerSearch As String
headerSearch = "HEADER Content-Type pkcs7-mime"

Dim messageSet As MessageSet
Dim fetchUids As Long
fetchUids = 1
Set messageSet = imap.Search(headerSearch,fetchUids)
If (messageSet Is Nothing ) Then
    MsgBox imap.LastErrorText
    Exit Sub
End If

'  Download the emails indicated in the messageSet.
'  The emails are automatically decrypted.
Dim bundle As ChilkatEmailBundle2
Set bundle = imap.FetchBundle(messageSet)
If (bundle Is Nothing ) Then

    MsgBox imap.LastErrorText
    Exit Sub
End If

'  Display some information from each email:
Dim i As Long
For i = 0 To bundle.MessageCount - 1
    Dim email As ChilkatEmail2
    Set email = bundle.GetEmail(i)

    Text1.Text = Text1.Text & email.GetHeaderField("Date") & vbCrLf
    Text1.Text = Text1.Text & email.Subject & vbCrLf
    Text1.Text = Text1.Text & email.From & vbCrLf

    Text1.Text = Text1.Text & "Received Encrypted: " _
         & email.ReceivedEncrypted & vbCrLf
    If (email.ReceivedEncrypted = 1) Then
        Text1.Text = Text1.Text & "Successfully Decrypted: " _
             & email.Decrypted & vbCrLf
    End If

    Text1.Text = Text1.Text & "Received Signed: " _
         & email.ReceivedSigned & vbCrLf
    If (email.ReceivedSigned = 1) Then
        Text1.Text = Text1.Text & "Signature Verified: " _
             & email.SignaturesValid & vbCrLf
    End If

    Text1.Text = Text1.Text & "--" & vbCrLf

Next

'  Disconnect from the IMAP server.
imap.Disconnect