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
jegajothyretiredAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
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
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
jegajothyretiredAuthor 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
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
jegajothyretiredAuthor 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
 
jegajothyretiredAuthor Commented:
A brilliant masterpiece - a piece of art I should say.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.