VBA & PGP:

Here is the Outlook VBA code to decrypt a PGP encrypted email attachement, using the COM wrapper Nsdpgp3Lib. You can download the Nsdpgp3Lib from here http://www.grt.net.tt/nsdpgp.html


Sub GetApplications()
    On Error GoTo GetApplications_err
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim FileNameOut As String
    Dim i As Integer
    Dim EmailBody  As String
    Dim fs As Object
    Dim A As Object
    Dim iPos As Integer
    Dim Header As String
    Dim PGPCOM As Object
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("AppsIn") ' Now check the email flder for any new emails
    i = 0
    If SubFolder.Items.Count = 0 Then
        Exit Sub
    End If
    If SubFolder.Items.Count > 0 Then
        For Each Item In SubFolder.Items
            For Each Atmt In Item.Attachments
                Set PGPCOM = CreateObject("Nsdpgp3Lib.PGP")
                FileNameOut = "C:\PGP_Data\Out\Test.csv"
                FileName = "C:\PGP_Data\Out\" & Atmt.FileName
                Atmt.SaveAsFile FileName
                Set A = PGPCOM.DecryptAndVerifyFile("C:\PGP_Data\Test.asc", "C:\PGP_Data\Test1.asc", FileName, FileNameOut, "C:\PGP_Data\Out\Test.txt", "ENTER_KEY_HERE")
                i = i + 1
            Next Atmt
            ' Now move the email
            Item.Move (GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("AppsRead"))
        Next Item
    End If
GetApplications_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
GetApplications_err:
   MsgBox Err.Description
   Resume GetApplications_exit
End Sub

This is the Outlook VBA code to get the email address from the email body.


Sub GetEmail()
    Dim RegE As RegExp
    Dim StringToSearch As String
    Dim OlApp As Outlook.Application
    Dim Inbox As Outlook.MAPIFolder
    Dim InboxItems As Outlook.Items
    Dim Mailobject As Outlook.MailItem
    Dim i As Integer
    Set RegE = New RegExp
    RegE.Pattern = "[_a-zA-Z\d\-\.]+@[_a-zA-Z\d\-]+(\.[_a-zA-Z\d\-]+)+"
    RegE.IgnoreCase = True
    RegE.Global = True
    Set OlApp = CreateObject("Outlook.Application")
    Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    Set InboxItems = Inbox.Items
    If Inbox.Items.Count = 0 Then
    Exit Sub
    End If
    For i = 1 To Inbox.Items.Count
    If Inbox.Items(i).Class = olMail Then
    Set Mailobject = Inbox.Items.Item(i)
    If Mailobject.UnRead Then
    StringToSearch = Mailobject.Body
    Set objMatches = RegE.Execute(StringToSearch)
    For Each objMatch In objMatches
    MsgBox (" TEST := " & objMatch.Value) ' This is the email address within the body text
    Next
    Mailobject.UnRead = False
    End If
    End If
    Next
    Set OlApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
End Sub