Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Outlook 2010 - creating a macro

Posted on 2012-12-21
6
741 Views
Last Modified: 2012-12-26
Is it possible to create a macro that will search in the email that is highlighted the IP address of  only the  sender.  Even if I run the macro  in the Spam or Junk folder.   Thank you.
0
Comment
Question by:jegajothy
  • 3
  • 3
6 Comments
 
LVL 50

Expert Comment

by:Rgonzo1971
ID: 38715357
Hi,

What do you mean by highlighted with a flag or selected, by IP address do you mean e-mail address?

Regards
0
 

Author Comment

by:jegajothy
ID: 38715404
In response to Rgonzo1971, I mean selected. If it ll make it easier, maybe when opened, I could run the macro.    Yes I want to know the IP address of the email sender. Thank u.
0
 
LVL 50

Expert Comment

by:Rgonzo1971
ID: 38715461
Hi,

This could help.
Since I am not on my work machine so no Outlook to verify the code

Do not forget to reference the regexp

Public Sub GetCurrentEmailInfo()
    Dim Session As Outlook.Namespace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
   
    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    
    'for all items do...
    For Each currentItem In Selection
        If currentItem.Class = olMail Then
            Set currentMail = currentItem
            IP_Address = GetIPAddresses(GetInetHeaders(currentMail))
            MsgBox currentMail.Sender & "/" & IP_Address, vbOKOnly
        End If
    Next

    
End Sub





Private Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
' Purpose: Returns the internet headers of a message.'
  Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
  Dim olkPA As Outlook.PropertyAccessor
  Set olkPA = olkMsg.PropertyAccessor
  GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
  Set olkPA = Nothing
End Function

Private Function GetIPAddresses(ByVal MsgHeader As String) As String()
 Dim tempArr() As String, i As Long, RegEx As Object, RegC As Object
 Set RegEx = CreateObject("vbscript.regexp")
 ReDim tempArr(0)
 With RegEx
  .Global = True
  .MultiLine = True
  .Pattern = "\[?(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]?"
 End With
 If RegEx.Test(MsgHeader) Then
  Set RegC = RegEx.Execute(MsgHeader)
  ReDim tempArr(RegC.Count - 1)
  For i = 0 To RegC.Count - 1
   tempArr(i) = RegC.Item(i).SubMatches(0)
  Next
 End If
 Set RegEx = Nothing
 Set RegC = Nothing
 GetIPAddresses = tempArr
End Function

Open in new window


Regards
0
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

Author Comment

by:jegajothy
ID: 38715704
In response to Rgfonzo1971, thank u.  Can u please advice how to implement this in Outlook?
Thank u.
0
 
LVL 50

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 38716898
Hi,

Please refer to http://msdn.microsoft.com/library/office/ee814736(v=office.14).aspx#odc_Office14_ta_AddingVBAProgrammingToYourOutlook2010Toolkit_VBAProgrammingInOutlook2010

Insert a module. Place the code inside (small correction)
Public Sub GetCurrentEmailInfo()
    Dim Session As Outlook.Namespace
    Dim currentExplorer As Explorer
    Dim mySelection As Outlook.Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
   
    Set currentExplorer = Application.ActiveExplorer
    Set mySelection = currentExplorer.mySelection
    
    'for all items do...
    For Each currentItem In mySelection
        If currentItem.Class = olMail Then
            Set currentMail = currentItem
            IP_Address = GetIPAddresses(GetInetHeaders(currentMail))
            MsgBox currentMail.Sender & "/" & IP_Address, vbOKOnly
        End If
    Next
End Sub

Private Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
' Purpose: Returns the internet headers of a message.'
  Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
  Dim olkPA As Outlook.PropertyAccessor
  Set olkPA = olkMsg.PropertyAccessor
  GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
  Set olkPA = Nothing
End Function

Private Function GetIPAddresses(ByVal MsgHeader As String) As String()
 Dim tempArr() As String, i As Long, RegEx As Object, RegC As Object
 Set RegEx = CreateObject("vbscript.regexp")
 ReDim tempArr(0)
 With RegEx
  .Global = True
  .MultiLine = True
  .Pattern = "\[?(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]?"
 End With
 If RegEx.Test(MsgHeader) Then
  Set RegC = RegEx.Execute(MsgHeader)
  ReDim tempArr(RegC.Count - 1)
  For i = 0 To RegC.Count - 1
   tempArr(i) = RegC.Item(i).SubMatches(0)
  Next
 End If
 Set RegEx = Nothing
 Set RegC = Nothing
 GetIPAddresses = tempArr
End Function

Open in new window


Make a reference to regexp in the Menu Tools / Reference
regexp
then assign a button to macro "GetCurrentEmailInfo", see first reference

Regards
0
 

Author Closing Comment

by:jegajothy
ID: 38720468
U sure got awesoime talent.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
Read this checklist to learn more about the 15 things you should never include in an email signature.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

790 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question