Create Macro for hyperlink(email) in message body

Status
Not open for further replies.

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: 648
  • Dig Alert Task Folder 2.jpg
    Dig Alert Task Folder 2.jpg
    282.6 KB · Views: 485

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
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?
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
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.
 

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
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.
 

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
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.
 

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
In that case you need to use html instead of plain text. Replace .Body by .HTMLBody, and add strStyle as a css style attribut to the text.
 

Alfredo Duran

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Office 365 Exchange
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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
If you're connected to an Exchange server, you can use the SentOnBehalfOfName property.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
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
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
C Can't create Outlook data file Outlook Wishlist 0
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
O Multiple email accounts - hesitate to create a new profile Using Outlook 3
G Can't create Folder Groups in Outlook 2013 Using Outlook 0
N Outlook rules don't create a copy for bcc'ed emails Using Outlook 3
F Delete/create/reset Exchange mailbox on Outlook.com Using Outlook.com accounts in Outlook 3
R Can not create folder to store specific emails in in Outlook for Mac Using Outlook 1
W Create Search Folder excluding Specific Email Addresses Using Outlook 5
K VBA BeforeItemMove event create rule to always move to its folder. Outlook VBA and Custom Forms 4
JackBlack What tools do you use to create the signature for email? Using Outlook 3
Rupert Dragwater How to create a new email with @outlook.com Using Outlook.com accounts in Outlook 32
F Should a new email account also create new contacts Using Outlook 2
D create an html table in outlook custom form 2010 using vba in MsAccess Outlook VBA and Custom Forms 7
R Outlook add-in to create new contact from an email. Using Outlook 0
Q Script to create a pst file for Archiving Using Outlook 1
Jennifer Murphy Can I create a Rule with Or'd conditions? Using Outlook 1
D Outlook macros to create meeting on shared calendar Outlook VBA and Custom Forms 10
G How do I create a custom pick list in VB for an outlook automated email? Outlook VBA and Custom Forms 1
L Create Custom Form Using Outlook 0
Diane Poremsky Create a Task when a Message is Flagged New Slipstick.com Articles 0
Stilgar Relsik Create a rule to copy text from an email and paste it in the subject line. Using Outlook 1

Similar threads

Top