I recently posted something like this in the dutch NG. It searched for a string in the subjects of the inbox (optionally filters to current month) then adds a hyperlink to the
message. It uses a class module to trap the"search complete" event from outlook, which may be a bit over your head. Give it a try anyway. INSERT A CLASSMODULE
note: CLASS module!! in properties window name it : COutlookSearch
Code:
Option Explicit
Dim WithEvents olApp As Outlook.Application
Const tagSS = "SubjectSearch"
Sub SubjectSearch(sSubject$, Optional sScope$ = "Inbox", Optional
bThisMonth As Boolean)
Const csFILTER As String =
"urn:schemas:mailheader:subject LIKE '%|s|%'"
Dim sFilter$, hLink As Hyperlink
For Each hLink In ActiveSheet.Hyperlinks
If hLink.Range.Column = 1 Then
hLink.Range.Clear
hLink.Delete
End If
Next
Set olApp = New Outlook.Application
sFilter = Replace(csFILTER, "|s|", sSubject)
If bThisMonth Then
sFilter = sFilter & " AND
%thismonth(urn:schemas:httpmail:datereceived)%"
End If
Call olApp.AdvancedSearch(sScope, sFilter, True, tagSS)
End Sub
Private Sub ProcessSubjectSearch(olSearch As Outlook.Search)
Dim i%
With olSearch.Results
If .Count = 0 Then
MsgBox "No items were found", vbExclamation, olSearch.Tag
Else
For i = 1 To .Count
With .Item(i)
ActiveSheet.Hyperlinks.Add _
anchor:=ActiveSheet.Range("A1").Cells(i, 1), _
Address:="outlook:" & .EntryID, _
TextToDisplay:=.Subject
End With
Next
End If
End With
Set olApp = Nothing
End Sub
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As
Outlook.Search)
Select Case SearchObject.Tag
Case tagSS
Call ProcessSubjectSearch(SearchObject)
Case Else
MsgBox "Unknown search has completed. Tag:" & SearchObject.Tag
End Select
End Sub
Once you are done with that you can insert a normal module name it: MEntry
Code:
Option Explicit
Dim mclsOLS As COutlookSearch
Sub CreateMailLinks()
Set mclsOLS = New COutlookSearch
mclsOLS.SubjectSearch "find this subject", , True
End Sub
Bookmarks