Solved

Outlook 2007 - Macro

Posted on 2011-09-10
14
206 Views
Last Modified: 2012-05-12
My OS is windows 7, like everyone I get tons of junk mail and I try to put them in the block list, but still they get thru.  I am trying to see if I can list the people who send me these junk mail and then maybe put them in the Blocjk List as a List.  
Using a previous code, I wrote something.  But instead of listing the From receipients, it is different result.  Frankly I do not know  where to tweak the code. The result is it is giving my own email address.  
I want to run this when I select my Junk folder, and then click on the macro and run it.
Hope a Guru could take a look and please correct it for me. thank u.
Sub JunkFile()

Dim outputFile As Object
Dim objFSO As Object
Dim recip As Recipient
Const strFileSpec As String = "c:\Deleteme\JunkMail.txt"

    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    MsgBox " I am inside the app "
    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)
'    Set outputFile = objFSO.createtextfile(strFileSpec, True)
    For Each recip In Application.ActiveExplorer.Selection(1).Recipients
        If recip.Type = olTo Then
            outputFile.Writeline recip.Address
        End If
    Next
    outputFile.Writeline "End of file" & " " & Now()
    outputFile.Close
    Set outputFile = Nothing
    MsgBox "end of processing "


End Sub

Open in new window

0
Comment
Question by:jegajothy
  • 7
  • 6
14 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36516770
Sounds to me as though you actually want the sender addy so ...

Chris
Sub JunkFile()

Dim outputFile As Object
Dim objFSO As Object
Dim recip As Object
Const strFileSpec As String = "c:\Deleteme\JunkMail.txt"

    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    MsgBox " I am inside the app "
    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)
'    Set outputFile = objFSO.createtextfile(strFileSpec, True)
    outputFile.Writeline Application.ActiveExplorer.Selection(1).SenderEmailAddress
    outputFile.Writeline "End of file" & " " & Now()
    outputFile.Close
    Set outputFile = Nothing
    MsgBox "end of processing "


End Sub

Open in new window

0
 
LVL 86

Expert Comment

by:CEHJ
ID: 36516778
Why is this in the Java TA btw?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36516804
Assuming you want the recipients then these are as you have shown recipients ... but we can filter out your primary address and any others if required as below.

Chris
Sub JunkFile()

Dim outputFile As Object
Dim objFSO As Object
Dim recip As Recipient
Const strFileSpec As String = "c:\Deleteme\JunkMail.txt"

    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    MsgBox " I am inside the app "
    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)
'    Set outputFile = objFSO.createtextfile(strFileSpec, True)
    For Each recip In Application.ActiveExplorer.Selection(1).Recipients
        If LCase(recip.Address) <> LCase(Application.Session.Accounts(1).SmtpAddress) Then
            If recip.Type = olTo Then
                outputFile.Writeline recip.Address
            End If
        End If
    Next
    outputFile.Writeline "End of file" & " " & Now()
    outputFile.Close
    Set outputFile = Nothing
    MsgBox "end of processing "


End Sub

Open in new window

0
 

Author Comment

by:jegajothy
ID: 36529358
in response to Chris, I want the sender's email address.  I tried both forms of your code, but they do not work.  Thank u for your resonse.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36529539
Senders email ... this would be the first form so what isn't working about it ... if you outline where the code is how you run it in terms of selection or expectations then I can try and work out the concern.

Chris
0
 

Author Comment

by:jegajothy
ID: 36533248
In response to Chris, this is the contents of the file :
jegajothy@MSN.COM
End of file 9/10/2011 12:19:31 PM
End of file 9/10/2011 12:29:49 PM
1tnt2008@aweber.com
End of file 9/13/2011 9:33:02 AM
jegajothy@msn.com
End of file 9/13/2011 9:34:22 AM

Thus, it failed to capture the sender's email address which is what is my intention.
Thank u.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36534028
I tried to avoid leading questions but you missed the point so for example before running the sub you select a single email, (per your original code) are you sure this email is one you received rather than sent?

Chris
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 

Author Comment

by:jegajothy
ID: 36540353
in response to Chris, I selected the junk folder to run the macro.  Not sure whether I am doing things rightly or not.  The idea is to select the senders of all the junk email to me, put them in a list, and then enter them into the blocked list in Outlook.  As the junk email run into thousands, thus I am choosing this method.  Thank u.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 36540859
The following automatically selects the junk folder and adds the sender to the output file, deleting the mail afterwards to prevent duplication.

(Comment out or delete the line mai.delete if you do not want to do this).

Chris
Sub JunkFile()
Dim mai As Object
Dim outputFile As Object
Dim objFSO As Object
Dim recip As Recipient
Const strFileSpec As String = "c:\Deleteme\JunkMail.txt"

'    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    MsgBox " I am inside the app "
    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)
'    Set outputFile = objFSO.createtextfile(strFileSpec, True)
    For Each mai In Application.Session.GetDefaultFolder(olFolderJunk).Items
        outputFile.Writeline Application.ActiveExplorer.Selection(1).SenderEmailAddress
        mai.Delete
    Next
    outputFile.Writeline "End of file" & " " & Now()
    outputFile.Close
    Set outputFile = Nothing
    MsgBox "end of processing "

End Sub

Open in new window

0
 

Author Comment

by:jegajothy
ID: 36556893
in response to Chris, well answered,thank u.  U are truly an awesome genius!
0
 

Author Closing Comment

by:jegajothy
ID: 36556896
Bravo for a well answered question.
0
 

Author Comment

by:jegajothy
ID: 36557053
IN RESPONSE TO CHRIS, my apologies I did not test your code before replying.  Now that I have tested it, the result is as follows :
newsmax@reply.newsmax.com
End of file 9/18/2011 2:53:08 PM
newsmax@reply.newsmax.com
End of file 9/18/2011 2:53:59 PM

I tried running the macro with the first message selected in the Junk Mail folder, and in the next run I selected all the messages (about 2,000) and then ran the macro.  
The results were the same.
Looks like back to the drawing board. Thank u.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36557136
Per your original code this affects the selected mail ... and only if there is one mail selected
0
 

Author Comment

by:jegajothy
ID: 36557742
In response to Chris, Here is the code that I ran.  Thank u for your assistance.
Sub JunkFile()
Dim mai As Object
Dim outputFile As Object
Dim objFSO As Object
Dim recip As Recipient
Const strFileSpec As String = "c:\Deleteme\JunkMail.txt"

'    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    MsgBox " I am inside the app "
    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)
'    Set outputFile = objFSO.createtextfile(strFileSpec, True)
    For Each mai In Application.Session.GetDefaultFolder(olFolderJunk).Items
        outputFile.Writeline Application.ActiveExplorer.Selection(1).SenderEmailAddress
        'mai.Delete - THIS DELETES THE FILE
    Next
    outputFile.Writeline "End of file" & " " & Now()
    outputFile.Close
    Set outputFile = Nothing
    MsgBox "end of processing "



End Sub

Open in new window

0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

Granting full access permission allows users to access mailboxes present in their database. By giving full access permission one can open and read the content of any mailbox but cannot send emails from that mailbox.
Use email signature images to promote corporate certifications and industry awards.
This tutorial covers a practical example of lazy loading technique and early loading technique in a Singleton Design Pattern.
This video teaches viewers about errors in exception handling.

706 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now