Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 446
  • Last Modified:

vb Script

My OS is windows 7 and I use Outlook 2007.  Endless times I get forwarded emails with countless email addresses, and I want to save them so that if they become a pest maybe a note to them to say stop it.
Is there a way to collect these email addresses from within an email, where the text is as follows :
----- Forwarded Message -----
From: "Rolando Halili" <rolandohalili@ymail.com>
To: "Marjorie Halili Acay" <marj.halili@gmail.com>, "michael schulthess" <mikoll23@yahoo.com>,

I would like to run a macro that would save the names and the email addresses to a text file, each name and email address to be on one line.
Thank u
0
jegajothy
Asked:
jegajothy
  • 3
  • 3
1 Solution
 
Chris BottomleyCommented:
Which emails are you looking for ... those in to/from etc - I doubt it as you have code for that already so is it mail addresses within the email body that follow the forwarded Message string?

Chris
0
 
jegajothyAuthor Commented:
In response to Chris, it is for the mail addresses within the email body that follow the forwarded message string.  Gosh, u will be surprised at the number of times  these things get forwarded and forwarded.  
0
 
Chris BottomleyCommented:
How do you want it to work ... run on a single mail selected or
all mails in the selected folder or
all mails in a folder you are invited to seelct as part of the macro

With respect to the output file;
create a new file of the given name every time or append the values to the file each time the macro is run?

Chris
0
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 
jegajothyAuthor Commented:
In response to Chris, just a single mail selected that I have opened and am viewing. .  thank u.
With regards to output, please append the values to the end of file that was first created.
0
 
Chris BottomleyCommented:
See Sub FwdAddies()

Again modify the line:
Const strFileSpec As String = "c:\deleteme\forwards.txt"

to point to your place for output.

Chris
Sub FwdAddies()
Dim outputFile As Object
Dim objFSO As Object
Dim addy As Variant
Dim mai As Object
Dim strMailAddies As String
Const strFileSpec As String = "c:\deleteme\forwards.txt"

    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set mai = Application.ActiveInspector.CurrentItem
    ElseIf TypeName(Application.ActiveWindow) = "Explorer" Then
        Set mai = Application.ActiveExplorer.Selection(1)
    Else
        Exit Sub
    End If
    
    If Application.ActiveExplorer.Selection.count <> 1 Then Exit Sub
    
    If fnValEmail(mai.body) And InStr(1, mai.body, "Forwarded Message", vbTextCompare) Then
        strMailAddies = fnGetEmails(mai.body)
        On Error Resume Next
        Set objFSO = CreateObject("scripting.filesystemobject")
        Set outputFile = objFSO.opentextfile(strFileSpec, 8)
        On Error GoTo 0
        If outputFile Is Nothing Then Set outputFile = objFSO.createtextfile(strFileSpec, True)
        For Each addy In Split(strMailAddies, ",")
            outputFile.Writeline Trim(addy)
        Next
        outputFile.Close
        Set outputFile = Nothing
    End If

End Sub

Function fnGetEmails(mailAddress As String) As String
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
Dim colmatch As Object
Dim itm As Variant
    
    Set regEx = CreateObject("vbscript.regexp")
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
    Set colmatch = regEx.Execute(mailAddress)
    For Each itm In colmatch
        fnGetEmails = fnGetEmails & itm & ", "
    Next
    fnGetEmails = Left(fnGetEmails, Len(fnGetEmails) - 2)
    
Set regEx = Nothing
End Function

Function fnValEmail(mailAddress As String) As Boolean
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
    
    Set regEx = CreateObject("vbscript.regexp")
    regEx.IgnoreCase = True
    regEx.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
    fnValEmail = regEx.test(mailAddress) = True
    
Set regEx = Nothing
End Function

Open in new window

0
 
jegajothyAuthor Commented:
A brilliant masterpiece - a piece of art I should say.
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now