Outlook - search, open, and save message

supertramp4
supertramp4 used Ask the Experts™
on
Hi,
I need some VBA code that will allow me to perform the following action.

1) Search all folders for a specific string ("-----BEGIN PGP MESSAGE-----")
For each message found the following actions needs to happen
2a) Open the message ( as a new window - not just in the preview panek
2b) The message can now be saved ( eg File -> Save )
2c) The opened window can now be closed

To put a bit more detail on the requirement.
We have PGP which stores specific email messages in the PST in an encryped form. The only readable part in the message is the search string.
The Action of opening the message invokes the PGP add-in to decrypt the message, and now the message has been decrypted, then message can be saved back into the PST in its non-encrypted form

I am offering max points, but will need full code example please
If its not possible in VBA, then VB or .NET could be used
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
Hi, supertramp4.

I can do it without opening the messages (i.e. find them and save them to the HD without them ever appearing on screen).  Will that work?

Author

Commented:
Hi Bluedevilfan,

I need the messages to be saved back to the PST as unencrypted messages, the reason is that we are moving over to exchange server and will need to transfer all information from client side to server side. I also want to preserve the message date

I think therefore saving them to Hard disk is not an option
Top Expert 2010

Commented:
Sorry, I read "File > Save" and was thinking you wanted to save to the HD.  So you just want to open the message and then save it?  If so, then I can do that without opening the message onscreen either.
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Author

Commented:
Hi BlueDevilFan:
Great, can you post some code ?
Top Expert 2010

Commented:
Is the string "BEGIN PGP MESSAGE" in the subject or the body?

Author

Commented:
Its in the body.
Top Expert 2010

Commented:
One last question.  What version of Outlook are you using?

Author

Commented:
outlook 2000 - And yes I know its old, but thats why I am doing this so I can migrate over to exchange

Thanks
Top Expert 2010

Commented:
Oh, boy.  I should have asked this question sooner.  It's been a really long time since I did anything in Outlook 2000.  I don't think my solution will work in that version as it uses features that I believe Microsoft introduced later.  I can still manage this simply by looping through every folder, but it means that the process is going to take a LOT longer.  Depending on the number of folders and items in each folder we could be talking about a long time.  Do you still want to proceed?

Author

Commented:
Hi ,
Sorry about that, but time is not a problem and would really appreciate your solution.
If you want me to try a simple test 1st to see if your more optimal solution will work then happy to help.
Thanks
Top Expert 2010

Commented:
Ok, I think this will do it.  I have to say "think" because as I mentioned I don't have a copy of 2000 anymore and can't remember for sure what was available in it.

Follow these instructions to add the code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor

Run the macro Supertramp (great band by the way).  It should loop through all the message stores (i.e. mailbox and/or PST files) searching each message for the string "-----BEGIN PGP MESSAGE-----".  If it finds it, then it saves the item.  
Sub Supertramp()
    Dim olkRoot As Outlook.MAPIFolder
    For Each olkRoot In Session.Folders
        ProcessFolder olkRoot
    Next
    Set olkRoot = Nothing
    msgbox "Finished"
End Sub

Sub ProcessFolder(olkFolder As Outlook.MAPIFolder)
    Dim olkItem As Object, olkSubfolder As Outlook.MAPIFolder
    On Error Resume Next
    For Each olkItem In olkFolder.Items
        If olkItem.Class = olMail Then
            If InStr(1, olkItem.Body, "-----BEGIN PGP MESSAGE-----") Then
                olkItem.Save
            End If
        End If
    Next
    For Each olkSubfolder In olkFolder.Folders
        ProcessFolder olkSubfolder
    Next
    On Error GoTo 0
    Set olkItem = Nothing
    Set olkSubfolder = Nothing
End Sub

Open in new window

Author

Commented:
Hi BlueDevilFan:

Thanks for the code.
I think due to the way that ther PGP Add-in works, the olkItem.Save is still saving the unencrypted message.
However if you "olkItem.Display", then the new message window opens and then you can File-> Save which definately saves the decrypyed message correctly.

So can your code be modified to :
        If olkItem.Class = olMail Then
            If InStr(1, olkItem.Body, "-----BEGIN PGP MESSAGE-----") Then
                olkItem.Display
                olkItem.Save ( on the newly opened window )
                olkItem.Close ( the opened window )
            End If
        End If

I know the above code is incorrect and there will be lots of flickering but it doesn't matter.

Any Thoughts
Top Expert 2010

Commented:
I don't have the add-in so I can't tell you if this'll achieve your goal.  From an Outlook perspective it'll work, although you can simplify it a bit by changing

                olkItem.Display
                olkItem.Save ( on the newly opened window )
                olkItem.Close ( the opened window )

to

                olkItem.Display
                olkItem.Close olSave

Author

Commented:
Hi BlueDevilFin,
Thanks for your continued support, and we are nearly there, but this PGP Add-in is still causing me grief, so I need to modify the code slightly as follows.

After olkItem.Display, I need to force VBA to execute an item on the menubar as shown in the image
So PGP -> Decrypy/Verify needs to be run.
Then I can olkItem.Close olSave

Is this possible ?
pgp.jpg
Top Expert 2010

Commented:
You're welcome.

It should be possible.  There are two possible solutions.  One, use SendKeys to send an ALT+P and D, thereby simulating the hotkeys to access the menu item.  The other is to access the menu selection directly through code.  The latter is the better approach, but to go that route I have to have the names or IDs of the underlying menu and control.  Since SendKeys is the easier of the two lets give it a try first.

                olkItem.Display
                SendKeys "%P", True
                SendKeys "D", True
                olkItem.Close olSave

Author

Commented:
Hi,
Unfortunately that did not work. After the olkDisplay, although the new window opens, the PGP item in the menubar is not there, however ( in debug mode) if I click the mouse in the new window and give it focus, then the PGP menu does appear.
Can we give the window focus first , because unless the PGP menu has been loaded neither method will work.
Top Expert 2010

Commented:
There aren't any commands for giving a message window focus.

Author

Commented:
Could it be done via API's
If so this is outside the scope of this questions, and would be happy to award points and post this to you under a new question ( but under the same objective of getting this problem working )
Top Expert 2010

Commented:
I suppose it could, but I'm not the best person to be doing API things with windows.  I've no experience with that.  Want to try the accessing the menus directly?  I can post code that'll get the information I need.  You'll have to run that and get me the name/ID of the menu selections.  That is unless you know how to look them up yourself.

Author

Commented:
Sure if you post your code i'll try it out.

Thanks.
Top Expert 2010

Commented:
Ok.  This code is from Sue Mosher's book "Microsoft Outlook Programming".  It documents the menus/toolbars of the active window.  Open a message then run the macro EnumCommandBars.  When it finishes it'll leave an open Post item that contains the documented toolbars.  Copy and paste that here and I'll see about writing the code that access the menus directly.
Sub EnumCommandBars()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim objDrafts As Outlook.MAPIFolder
    Dim objPost As Outlook.PostItem
    Dim colCB As Office.CommandBars
    Dim objCB As Office.CommandBar
    Dim strWindow As String
    Dim strExplBars As String
    Dim strInspBars As String
    Dim strText As String
    Dim arrBars() As String
    Dim i As Integer
    On Error Resume Next
    Set objOL = Application
    Set objNS = objOL.Session
    Set objDrafts = objNS.GetDefaultFolder(olFolderDrafts)
    strExplBars = "Menu Bar,Standard,Advanced,Web"
    strInspBars = "Menu Bar,Standard,Form Design,Formatting"
    strWindow = TypeName(objOL.ActiveWindow)
    Select Case strWindow
        Case "Explorer"
            Set colCB = objOL.ActiveExplorer.CommandBars
            arrBars = Split(strExplBars, ",")
        Case "Inspector"
            Set colCB = objOL.ActiveInspector.CommandBars
            arrBars = Split(strInspBars, ",")
    End Select
    If Not colCB Is Nothing Then
        Set objPost = objDrafts.Items.Add("IPM.Post")
        objPost.Subject = "CommandBars for " & strWindow & _
                          ": " & colCB.Parent.Caption
        objPost.BodyFormat = olFormatPlain
        For i = 0 To UBound(arrBars)
            Set objCB = colCB.Item(arrBars(i))
            Call EnumOneBar(objCB, strText)
            strText = strText & vbCrLf & "===========" & vbCrLf
        Next
        objPost.Body = Mid(strText, 5)
        objPost.Save
        objPost.Display
    End If
    Set objOL = Nothing
    Set objNS = Nothing
    Set objDrafts = Nothing
    Set objPost = Nothing
    Set colCB = Nothing
    Set objCB = Nothing
End Sub

Sub EnumOneBar(cb As Office.CommandBar, ByRef postText)
    Dim objControl As Office.CommandBarControl
    Dim objPopupControl As Office.CommandBarPopup
    postText = postText & vbCrLf & vbCrLf & "CommandBar: " & cb.Name
    For Each objControl In cb.Controls
        If objControl.BuiltIn = True Then
            Select Case objControl.Type
                Case msoControlPopup, _
                     msoControlButtonPopup, _
                     msoControlGraphicPopup, _
                     msoControlSplitButtonPopup
                    postText = postText & vbCrLf & vbCrLf & _
                      objControl.Caption & _
                      " (Submenu) - " & objControl.ID
                    Set objPopupControl = objControl
                    Call EnumOneBar( _
                      objPopupControl.CommandBar, postText)
                 Case Else
                    postText = postText & vbCrLf & vbTab & _
                      objControl.Caption & " - " & objControl.ID
            End Select
        End If
    Next
    Set objControl = Nothing
    Set objPopupControl = Nothing
End Sub

Open in new window

Author

Commented:
Hi
Your code worked, but the results are not so good. Here's the results around the PGP section

&PGP (Submenu) - 0

CommandBar: Bogus
      &Decrypt/Verify - 0
      &Launch PGPkeys - 0
      &Options... - 0

&Tools (Submenu) - 30007

CommandBar: Tools
      &Spelling... - 2
      &AutoCorrect... - 793
      Chec&k Names - 361
      &Protect Document - 336
      Letter Wi&zard... - 796

As you can see the PGP section has all returned all Zero's, so unless you have some great idea's, then I think we have gone as far as we can.
Let me know, but am happy to award you the points - Its been great working with you.
Top Expert 2010
Commented:
Well, no guarantee that this will work, but you can try the code below.  It attempts to access the menus directly.
Sub Supertramp()
    Dim olkRoot As Outlook.MAPIFolder
    For Each olkRoot In Session.Folders
        ProcessFolder olkRoot
    Next
    Set olkRoot = Nothing
    msgbox "Finished"
End Sub

Sub ProcessFolder(olkFolder As Outlook.MAPIFolder)
    Dim olkItem As Outlook.MailItem, olkSubfolder As Outlook.MAPIFolder
    Dim olkCmdBar As Object, _
        olkCmdBarPop As Object, _
        olkCmdBarBtn As Object, _
        olkInspector As Object
    On Error Resume Next
    For Each olkItem In olkFolder.Items
        If olkItem.Class = olMail Then
            If InStr(1, olkItem.Body, "-----BEGIN PGP MESSAGE-----") Then
                olkItem.Display
                Set olkInspector = olkItem.GetInspector
                Set olkCmdBar = olkInspector.CommandBars("Menu Bar")
                Set olkCmdBarPop = olkCmdBar.Controls("PGP")
                Set olkCmdBarBtn = olkCmdBarPop.Controls.Item(1)
                olkCmdBarBtn.Execute
                olkItem.Close olSave
                Set olkCmdBarBtn = Nothing
                Set olkCmdBarPop = Nothing
                Set olkCmdBar = Nothing
                Set olkInspector = Nothing
            End If
        End If
    Next
    For Each olkSubfolder In olkFolder.Folders
        ProcessFolder olkSubfolder
    Next
    On Error GoTo 0
    Set olkItem = Nothing
    Set olkSubfolder = Nothing
End Sub

Open in new window

Author

Commented:
Very professional, and great communication.
Top Expert 2010

Commented:
Thanks!  It was a pleasure working with you on this question.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial