Create Macro for hyperlink(email) in message body

Status
Not open for further replies.
A

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
I would like some help with a macro. I receive an email from dig alerts everyday and I have a rule that sends them to my task folder. When I open the email, I would like to create a macro so when I click on the hyperlink that is included in the message body, runs the macro and sends it to a template that will put the hyperlink on the To box, the subject will say "USA Dig Alert Notification" and the Body will have "NO CONFLICT" and the original message below that. I will upload some files to see what I mean. Any help is really appreciated. Thank You.
 

Attachments

  • Dig Alert Task Folder.jpg
    Dig Alert Task Folder.jpg
    249.2 KB · Views: 981
  • Dig Alert Task Folder 2.jpg
    Dig Alert Task Folder 2.jpg
    282.6 KB · Views: 816
Ok maybe this would be much easier. How do I reply to a link in an email to open a template I have created already?
 
Getting the mouse click on the link would be difficult. Instead parse the body of the email for the link and if found, call the Reply function for that email. For parsing the Body either use the Instr function if you know what words to look for, or use regular expressions. The latter isn't easy for most beginners, search this forum for samples, for sure Diane has some for you.
 
Thanks Michael. I was able to piece together a code that did partially what I wanted. It put the email from the original email body into a reply email in the To: field and copied the original email into the new reply email.Now I just need help with changing the subject to say "USA Dig Alert" and I want to include "No conflict" also in the body along with the original email. I will include the code to see if someone can suggest how to go about it.
 
Sub ReplyTest()
Dim objItem As Object
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strAddress As String
Dim objReply As MailItem

Set objItem = GetCurrentItem()
If objItem.Class = olMail Then
' find the requestor address
strAddress = ParseTextLinePair(objItem.Body, "Requestor Email:")

' create the reply, add the address and display
Set objReply = objItem.Reply
objReply.To = strAddress
objReply.Display

End If

Set objReply = Nothing
Set objItem = Nothing
End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.currentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function
 
To add something at the beginning of the Body property, write this
Code: 
objReply.Body = "new stuf" & vbcrlf & objReply.Body
As to the Subject property, guess how you would set that one.
 
Ok I got it to work Michael. Now how change I change the font color on the objReply.Body = "NO CONFLICT WITH SEWER MAINTENANCE FORCE MAIN" to a red font. Thanks for the help!

Sub ReplyTest()
Dim objItem As Object
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strAddress As String
Dim objReply As MailItem

'this gets the subject from original email
Set objItem = GetCurrentItem()
If objItem.Class = olMail Then
' find the requestor address
strAddress = ParseTextLinePair(objItem.Body, "Email: ")
'strAddress = email in original body of Dig Alert
' create the reply, add the address and display
'Set objReply puts RE: xxxxx into subject field objItem.Reply
Set objReply = objItem.Reply
'puts email address from orig. email into new email To: field
objReply.To = strAddress
'removes the Re: in the subject
objReply.subject = "USA Dig Alert"
objReply.subject = Replace(objReply.subject, "Re:", "", , , vbTextCompare)
strStyle = "'font-family:" & Chr(34) & "Calibri" & Chr(34) & ";color:red'"
objReply.Body = "NO CONFLICT WITH SEWER MAINTENANCE FORCE MAIN." & vbNewLine & vbNewLine & vbNewLine & objItem.Body
objReply.Display

End If

Set objReply = Nothing
Set objItem = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.CurrentItem 'Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function

Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel) 'strLabel adds email in body to To: Field
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
 
Thanks Michael. Figured it out and it has been working with no glitches. Now I have another problem. I share my task folder with other co-workers. They use this macro to reply to my emails that are shared on the task folder. Work will not allow me to delegate access to them so they can send on my behalf, so can I add something to the macro to change the From: field to them instead of from me? Here is the current macro I have.

Sub Reply()
Dim objItem As Object
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strAddress As String
Dim objReply As MailItem

'this gets the subject from original email
Set objItem = GetCurrentItem()
If objItem.Class = olMail Then
' find the requestor address
strAddress = ParseTextLinePair(objItem.Body, "Email: ")
'strAddress = email in original body of Dig Alert
' create the reply, add the address and display
'Set objReply puts RE: xxxxx into subject field objItem.Reply
Set objReply = objItem.Reply
'puts email address from orig. email into new email To: field
objReply.To = strAddress
'removes the Re: in the subject
objReply.subject = "USA Dig Alert"
objReply.subject = Replace(objReply.subject, "Re:", "", , , vbTextCompare)
objReply.Body = "NO CONFLICT WITH SEWER MAINTENANCE FORCE MAIN." & vbNewLine & vbNewLine & vbNewLine & objItem.Body
objReply.Display

End If

Set objReply = Nothing
Set objItem = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.CurrentItem 'Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function

Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel) 'strLabel adds email in body to To: Field
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
 
Status
Not open for further replies.
< Automatically Move Old Items from a Shared Mailbox to a .PST on a Network Drive | VBScript Sendmail not selecting correct 'from' address >
Similar threads
Thread starter Title Forum Replies Date
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
A Outlook macro to create search folder with mail categories as criteria Outlook VBA and Custom Forms 3
Tanja Östrand Outlook 2016 - Create Macro button to add text in Subject Outlook VBA and Custom Forms 1
B Macro To Create Rule To Export From Certain Folder Email Information in one workbook multiple sheets Outlook VBA and Custom Forms 0
L Macro Create Contact and Save Using Outlook 2
L Macro Create Contact and Save Using Outlook 8
S Macro to create notification emails Using Outlook 1
N Macro to create task Using Outlook 1
S Macro to create a new folder with subject line as the folder name Using Outlook 2
P Please Help me Create a Macro ! Using Outlook 2
S Macro to create a new contact, 2 appointments, and a task Using Outlook 1
M How to Create Macro in Visual Basic to add Contacts from Personal Folder Using Outlook 4
R How do I create a macro to put text in certain emails? Outlook VBA and Custom Forms 1
D Create a macro in Outlook to run a rule Outlook VBA and Custom Forms 32
N How Can I create an Outlook Macro to import calendar? Outlook VBA and Custom Forms 1
P How do I create a macro to add contacts from email messages? Outlook VBA and Custom Forms 1
J Macro to create folder in PST file Outlook VBA and Custom Forms 4
G Macro: Create New Message and Auto populate To Field Outlook VBA and Custom Forms 5
S How to create a macro to insert a signature in Outlook 2007 Outlook VBA and Custom Forms 1
S Create Outlook Task from Template and append Body with Email Body Outlook VBA and Custom Forms 4
B Modify VBA to create a RULE to block multiple messages Outlook VBA and Custom Forms 0
J Want to create a button on the nav bar (module add-in) to run code Outlook VBA and Custom Forms 2
B How to create a button that sorts and selects the most recent message with ONE click Using Outlook 2
J PSA: How to create custom keyboard shortcut for "Paste Unformatted Text" in Outlook on Windows Outlook VBA and Custom Forms 1
W Create a Quick Step or VBA to SAVE AS PDF in G:|Data|Client File Outlook VBA and Custom Forms 1
Wotme create email only data file Using Outlook 1
J How to create a drop down user defined field that will appear on an inbox view Outlook VBA and Custom Forms 8
Commodore Any way to create "from-only" account on Outlook 2021? Using Outlook 1
L Capture email addresses and create a comma separated list Outlook VBA and Custom Forms 5
N Can't create NEW GROUP and add/remove a member from existing Group in Outlook Using Outlook 1
NVDon Create new Move To Folder list Outlook VBA and Custom Forms 0
C Create Meeting With Custom Form Outlook VBA and Custom Forms 2
D Create advanced search (email) via VBA with LONG QUERY (>1024 char) Outlook VBA and Custom Forms 2
G Create ordinal numbers for birthday Outlook VBA and Custom Forms 2
O Outlook 365 - How to create / copy a new contact from an existing one? Using Outlook 5
D Create new email from the received Email Body with attachment Outlook VBA and Custom Forms 10
A How to create fixed signatures for aliases that process through GMAIL? Outlook VBA and Custom Forms 0
P Can I create a Rule that sends me an email when I get a Task? Using Outlook 2
M How create a Rule to filter sender's email with more that one @ sign Using Outlook 1
B Can I create a local PST file for SPAM on a drive that is usually disconnected? Using Outlook 3
Chiba Create an appointment for all the members Outlook VBA and Custom Forms 1
S Create a clickable custom column field Outlook VBA and Custom Forms 0
O Create a custom contact form - questions before messing things up... Outlook VBA and Custom Forms 4
L automaticaly create a teams meeting with a sync Using Outlook 0
D Can Exchange Admin Center create a pst for users email/contacts/calendar? Exchange Server Administration 0
S Create A Search Folder That Looks For Message Class? Outlook VBA and Custom Forms 0
F How to create phone number as links in notes of Contacts Using Outlook 2
Nessa Can't create new appointment Using Outlook 1
A Create date folder and move messages daily Outlook VBA and Custom Forms 1
C Create new Message with shared contacts & BCC'ing recipients Outlook VBA and Custom Forms 0

Similar threads

Back
Top