ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Insert Outlook Message into Excel cell (https://www.excelbanter.com/excel-discussion-misc-queries/31238-insert-outlook-message-into-excel-cell.html)

Andy

Insert Outlook Message into Excel cell
 
I am attempting to inset and Outlook message into a cell in Excel. This is to
enable me to keep a log of e-mails for particular topics and to store them
within Excel so that I could double-click within the spreadsheet and bring up
the e-mail.

Have tried copying, pasting, importing, linking all to no avail. Any further
ideas/help or perhaps a way to do in Access?

keepITcool


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

Copy:


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

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<


Next:
insert a normal module
name it:
MEntry

copy:

Option Explicit
Dim mclsOLS As COutlookSearch

Sub CreateMailLinks()
Set mclsOLS = New COutlookSearch
mclsOLS.SubjectSearch "find this subject", , True
End Sub

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<







--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Andy wrote :

I am attempting to inset and Outlook message into a cell in Excel.
This is to enable me to keep a log of e-mails for particular topics
and to store them within Excel so that I could double-click within
the spreadsheet and bring up the e-mail.

Have tried copying, pasting, importing, linking all to no avail. Any
further ideas/help or perhaps a way to do in Access?



All times are GMT +1. The time now is 06:54 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com