Open hyperlink in received email and send

[dmhcdk]

Hi, I was trying to run a macro when an email is received from a specific sender. Once that happens and the macro is triggered, I'd like it to open a hyperlink within the body of that email based on the display text of the hyperlink (since there are multiple hyperlinks, I only want to open the 1 link that has the display text of "Approve"). Once this link opens, it opens another email where I have to press send. I would also like it to send this new email that pops up automatically.

Does anyone know how this can be accomplished? Please let me know, thanks.

[gmayor]

Without knowing more about the messages, it is not possible to be specific, but the following should be close. You can run the main macro from a rule that identifies the incoming message (but I have included a macro to test with a selected message)


Option Explicit

Sub TestMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
GetLink olMsg
lbl_Exit:
Exit Sub
End Sub

Sub GetLink(olItem As MailItem)
Dim olInsp As Outlook.Inspector, olNewInsp As Outlook.Inspector
Dim wdDoc As Object, wdNewDoc As Object
Dim oRng As Object, oNewRng As Object
Dim oLink As Object
Dim olNewItem As MailItem
Dim strAddress As String
With olItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
For Each oLink In oRng.Hyperlinks
If oLink.TextToDisplay = "Approve" Then
Set olNewItem = olItem.Reply
With olNewItem
strAddress = oLink.Address
strAddress = Replace(strAddress, "mailto:", "")
strAddress = Left(strAddress, InStr(1, strAddress, "?") - 1)
.To = strAddress
Set olNewInsp = .GetInspector
Set wdNewDoc = olNewInsp.WordEditor
Set oNewRng = wdNewDoc.Range(0, 0)
.Display
oNewRng.Text = "This is the covering message text"
'.Send 'Restore after testing
End With
olItem.Close olDiscard
Exit For
End If
Next oLink
End With
lbl_Exit:
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oLink = Nothing
Exit Sub
End Sub

[dmhcdk]

Thanks gmayor, that gets me closer to what I was looking to accomplish. However, I was trying to replicate the same effect as clicking on the hyperlink. There doesn't seem to be any code to activate the link, so I suppose it has to be done another way?

The email address in the Edit Hyperlink box displays in percent code form. And so a "%2B" should actually display as a "+". Additionally, the subject line in the Edit Hyperlink box displayed in percent code format as well, which I need to translate to legible sentences. And it seems to include both the subject and the body message in the one line which I need to separate out in to their respective locations in the email draft.
Could you please advise?

[gmayor]

Without knowing what is in the link, it is difficult to address the range of possibilities, but the following should work, and if you need to add more codes, they are listed at http://www.w3schools.com/tags/ref_urlencode.asp

Clicking an e-mail Hyperlink does not send a reply as in my earlier code, but creates a new message. I have modified the code to do that. You can change or omit the message text (oNewRng.Text = "This is the covering message text") as appropriate


Option Explicit

Sub TestMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
GetLink olMsg
lbl_Exit:
Exit Sub
End Sub

Sub GetLink(olItem As MailItem)
Dim olInsp As Outlook.Inspector, olNewInsp As Outlook.Inspector
Dim wdDoc As Object, wdNewDoc As Object
Dim oRng As Object, oNewRng As Object
Dim oLink As Object
Dim olNewItem As MailItem
Dim strAddress As String
Dim strSubject As String
With olItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
For Each oLink In oRng.Hyperlinks
If oLink.TextToDisplay = "Approve" Then
Set olNewItem = CreateItem(0)
With olNewItem
strAddress = oLink.Address
strAddress = Replace(strAddress, "mailto:", "")
strAddress = Left(strAddress, InStr(1, strAddress, "?") - 1)
strSubject = Replace(oLink.emailsubject, "%20", Chr(32))
strSubject = Replace(strSubject, "%2B", "+")
'repeat to replace any other codes used.
.To = strAddress
.Subject = strSubject
Set olNewInsp = .GetInspector
Set wdNewDoc = olNewInsp.WordEditor
Set oNewRng = wdNewDoc.Range(0, 0)
.Display
oNewRng.Text = "This is the covering message text"
'.Send 'Restore after testing
End With
olItem.Close olDiscard
Exit For
End If
Next oLink
End With
lbl_Exit:
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oLink = Nothing
Exit Sub
End Sub

[dmhcdk]

I tweaked the macro (shown below) to provide the result I need. I noticed your code used oLink.emailsubject to separate out the subject line, which seems to work without further intervention. And with oLink.address, I noticed you had to separate the address portion using LEFT and INSTR.



I realized that the body message I need to reply with was contained within the subject line of the hyperlink. However, I had to use oLink.address and then further separate out using RIGHT, LEN, and INSTR. Is there a more efficient way to do this? I tried using oLink.body to extract the body portion but that didn’t work.
Also wondering if there is a method to decode all the URLs instead of having to manually specify each character replacement (i.e. replace %20 with chr(32), %21 with “!”, etc.).


Thanks again.



Option Explicit

Sub TestMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
GetLink olMsg
lbl_Exit:
Exit Sub
End Sub

Sub GetLink(olItem As MailItem)
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oLink As Object
Dim olNewItem As MailItem
Dim strAddress As String
Dim strSubject As String
Dim strBody As String
With olItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
For Each oLink In oRng.Hyperlinks
If oLink.TextToDisplay = "Approve" Then
Set olNewItem = CreateItem(0)
With olNewItem
strAddress = Left(oLink.Address, InStr(1, oLink.Address, "?") - 1)
strAddress = Replace(strAddress, "mailto:", "")
strAddress = Replace(strAddress, "%2B", "+")
strSubject = Replace(oLink.emailsubject, "%20", Chr(32))
strBody = Right(oLink.Address, Len(oLink.Address) - InStr(1, oLink.Address, "body=") - 4)
strBody = Replace(strBody, "%5B", "[")
strBody = Replace(strBody, "%3A", ":")
strBody = Replace(strBody, "%20", Chr(32))
strBody = Replace(strBody, "%5D", "]")
strBody = Replace(strBody, "%0A", Chr(10))
strBody = Replace(strBody, "%2C", ",")
strBody = Replace(strBody, "%21", "!")
strBody = Replace(strBody, "%3B", ";")
'repeat to replace any other codes used.
.To = strAddress
.Subject = strSubject
.Body = strBody
.Display
'.Send 'Restore after testing
End With
olItem.Close olDiscard
Exit For
End If
Next oLink
End With
lbl_Exit:
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oLink = Nothing
Exit Sub
End Sub