Solved

Search for Email Subject String

Posted on 2009-04-07
7
748 Views
Last Modified: 2013-11-27
Hello - This code is working perfectly, but I have run into a situation where I need to search for specific text in the subject.  I have not been able to figure out how to fit that into this existing code.  Can you please help me update this code to search for a text string.

I need to find "EverBank" within the subject text.
Dim olApp, objFolder, objNameSpace
    Dim objItems, objMess
    Dim strFilter As String
    Dim Regex As Object, regm As Object, IE As Object
    Dim ieLink, i As Long
    strFilter = "[subject] = ""EverBank Rates"""
 
 
    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.GetDefaultFolder(6)
    objFolder.Items.Sort "[Received]", False
    Set objItems = objFolder.Items
    objItems.Sort "[Received]", True
    Set objMess = objItems.Find(strFilter)
 
    If objMess Is Nothing Then
        MsgBox "No email found!", vbCritical
        Exit Sub
    End If
 
    Set Regex = CreateObject("vbscript.regexp")
    Regex.Pattern = "((file?|ftp|gopher|telnet|file|notes|ms-help):((//)|(\\\\))+[\w\d:#@%/;$()~_?\+-=\\\.&]*.pdf)"
    Regex.Global = True
    If Regex.test(objMess.body) Then
        Set regm = Regex.Execute(objMess.body)
       Forms("frmPricingLoadExternal")!txtFileLoc.Value = Right$(regm(0), Len(regm(0)) - InStr(regm(0), "*"))  '& "?download=yes&cpw="
    End If
    Set olApp = Nothing
    Set Regex = Nothing

Open in new window

0
Comment
Question by:rsburge
  • 4
  • 3
7 Comments
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24092959
Hi again,
So 'EverBank Rates' is only part of the Subject?
As the current code will find 'EverBank Rates' if it is the full subject
Cheers
Dave
0
 

Author Comment

by:rsburge
ID: 24093133
Hi Dave.  Thank you for looking at this question.  Yes, EverBank Rates is only part of the subject and it can be anywhere in the subject (for some reason it is never in the same place).  Some examples are... EverBank Rates for 04072009, Today's EverBank Rates, Your EverBank Rates, Current Pricing - EverBank Rates, Wholesale EverBank Rates for 04/03/09, and tomorrow it might be different again.  :)
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 24093450
try this
Cheers
Dave


Sub take2()
Const strF As String = "urn:schemas:mailheader:subject like '%EverBank Rates%'"
    Dim olApp, objFolder, objNameSpace
    Dim oSrh As Search, rsts As Results
    Dim objItems, objMess As MailItem
    Dim Regex As Object, regm As Object, IE As Object
    Dim ieLink, i As Long
 
 
    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.GetDefaultFolder(6)
    objFolder.Items.Sort "[Received]", False
    Set objItems = objFolder.Items
    objItems.Sort "[Received]", True
  
 
    Set oSrh = Application.AdvancedSearch("Inbox", strF)
    Set rsts = oSrh.Results
 
    If rsts Is Nothing Then
        MsgBox "No email found!", vbCritical
        Exit Sub
    End If
 
    Set objMess = rsts.GetFirst
 
    Set Regex = CreateObject("vbscript.regexp")
    Regex.Pattern = "((file?|ftp|gopher|telnet|file|notes|ms-help):((//)|(\\\\))+[\w\d:#@%/;$()~_?\+-=\\\.&]*.pdf)"
    Regex.Global = True
    If Regex.test(objMess.Body) Then
        Set regm = Regex.Execute(objMess.Body)
         Forms("frmPricingLoadExternal")!txtFileLoc.Value = Right$(regm(0), Len(regm(0)) - InStr(regm(0), "*"))  '& "?download=yes&cpw="
    End If
    Set olApp = Nothing
    Set Regex = Nothing
End Sub

Open in new window

0
NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

 

Author Comment

by:rsburge
ID: 24093522
Thank you Dave!  This is awesome.  I had to make one minor adjustment...  I changed the following

from
    Set oSrh = Application.AdvancedSearch("Inbox", strF)

to
    Set oSrh = olApp.AdvancedSearch("Inbox", strF)
0
 

Author Closing Comment

by:rsburge
ID: 31567817
Thanks again!  I really appreciate all of your help!  Renee
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24093533
thx for the grade Renee :)
Good pick up on the Application naming
Cheers
Dave
0
 

Author Comment

by:rsburge
ID: 24093654
You're welcome; well earned as always.

While I still have a million questions, I am learning.  :)

Have a wonderful day!

Renee
0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

861 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question