Solved

Outlook 2010 - creating a macro

Posted on 2012-12-21
6
737 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 49

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 49

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
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 

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 49

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

Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

Question has a verified solution.

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

Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Viewers will learn the different options available in the Backstage view in Excel 2013.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

809 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