Forum

ADD LINK TO EMAIL T...
 
Notifications
Clear all

ADD LINK TO EMAIL TO OPEN

10 Posts
3 Users
0 Reactions
104 Views
(@josros60)
Posts: 47
Trusted Member
Topic starter
 

Hi,

 

Can this code below be modify that also in the spreadsheet link to email that can open it? much appreciated your help.

 

Option Explicit
Dim n As Long
Sub Launch_Pad()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1 As Date
Dim Date2 As Date
Dim Subject As String
Application.ScreenUpdating = False
Date1 = Range("J2").Value
Date2 = Range("K2").Value
Subject = Range("L2").Value

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

Call ProcessFolder(olFolder, Subject, Date1, Date2)
Application.ScreenUpdating = True
Set olFolder = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub

Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, _
Subject As String, _
StartDate As Date, _
EndDate As Date)
Dim olObject As Object
Dim n As Long

n = 2

For Each olObject In olfdStart.Items

If TypeName(olObject) = "MailItem" Then

If Int(olObject.ReceivedTime) >= StartDate And Int(olObject.ReceivedTime) <= EndDate Then

If olObject.Subject Like "*" & Subject & "*" Then

Cells(n, 1).Value = olObject.Subject
If Not olObject.UnRead Then Cells(n, 2).Value = "Message is read" Else Cells(n, 2).Value = "Message is unread"
Cells(n, 3).Value = olObject.ReceivedTime
Cells(n, 4).Value = olObject.LastModificationTime
Cells(n, 5).Value = olObject.Body
Cells(n, 6).Value = olObject.SenderName
Cells(n, 7).Value = olObject.FlagRequest

n = n + 1
End If
End If
End If
Next

Set olObject = Nothing
End Sub
Sub Formatting()
Application.ScreenUpdating = False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.ScreenUpdating = True
End Sub

Sub DelLastRowCols()
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Range("A3:G3" & lastrow).Select
Selection.Clear
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Sub final()
Call DelLastRowCols
Call Launch_Pad
Call Formatting
End Sub

 

Thank you

 
Posted : 28/10/2023 2:43 pm
(@josros60)
Posts: 47
Trusted Member
Topic starter
 

Any help, please?

 
Posted : 31/10/2023 10:39 am
(@keebellah)
Posts: 373
Reputable Member
 

Hi José,

The solution is to create a copy of that worksheet without the  macros and email that as an attachment.

I don't use Outlook but the idea is that you create a copy of that worksheet in the TEMP folder and attach this to the email.

You have not told us which version of Excel you are using.

 
Posted : 01/11/2023 3:17 am
(@josros60)
Posts: 47
Trusted Member
Topic starter
 

Sorry, put the wrong code actually this is the one want to modify that has hyperlink to open that email.

So I wonder to add another line to display email link to open like:

Cells(n, 8).Value = olObject.email        'something like that.

 

Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, _
Subject As String, _
StartDate As Date, _
EndDate As Date)
Dim olObject As Object
Dim n As Long

n = 2

For Each olObject In olfdStart.Items

If TypeName(olObject) = "MailItem" Then

If Int(olObject.ReceivedTime) >= StartDate And Int(olObject.ReceivedTime) <= EndDate Then

If olObject.Subject Like "*" & Subject & "*" Then

Cells(n, 1).Value = olObject.Subject
If Not olObject.UnRead Then Cells(n, 2).Value = "Message is read" Else Cells(n, 2).Value = "Message is unread"
Cells(n, 3).Value = olObject.ReceivedTime
Cells(n, 4).Value = olObject.LastModificationTime
Cells(n, 5).Value = olObject.Body
Cells(n, 6).Value = olObject.SenderName
Cells(n, 7).Value = olObject.FlagRequest

n = n + 1
End If
End If
End If
Next

Set olObject = Nothing
End Sub

 

Thank youemail-link.png

 
Posted : 03/11/2023 12:10 pm
(@keebellah)
Posts: 373
Reputable Member
 

It seems it's hard to answer:

What version of Office (Excel) are you using ?

 

That's not such a difficult question.

 
Posted : 04/11/2023 10:30 am
(@josros60)
Posts: 47
Trusted Member
Topic starter
 

Office 365.

 

Thank you,

 
Posted : 04/11/2023 11:16 am
(@keebellah)
Posts: 373
Reputable Member
 

Okay, clear, but since I do not use Outlook on my system and do not have Office 365 I cannot help you. 

Sorry.

I'm sure someone else here can help you.

 
Posted : 05/11/2023 3:11 am
(@debaser)
Posts: 838
Member Moderator
 

How would you do it manually? I'm not aware of any hyperlink options to link to a specific email.

 
Posted : 07/11/2023 5:41 am
(@josros60)
Posts: 47
Trusted Member
Topic starter
 

I used the code in this thread, either hyperlink to the email or to the attachment.

 

Thank you,

 
Posted : 07/11/2023 1:14 pm
(@debaser)
Posts: 838
Member Moderator
 

I think you misunderstood. There is nothing in that code that adds any sort of hyperlink.

 

What I am asking is how would you do it manually? There is no way I know of to hyperlink to an individual outlook email, but if you know of a way to do it manually, we may be able to figure out a code equivalent.

 
Posted : 08/11/2023 6:14 am
Share: