Outlook 2007 - Macro

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

jegajothyretiredAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
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
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
CEHJCommented:
Why is this in the Java TA btw?
0
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.

 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
jegajothyretiredAuthor Commented:
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
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
jegajothyretiredAuthor Commented:
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
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
jegajothyretiredAuthor Commented:
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
 
jegajothyretiredAuthor Commented:
in response to Chris, well answered,thank u.  U are truly an awesome genius!
0
 
jegajothyretiredAuthor Commented:
Bravo for a well answered question.
0
 
jegajothyretiredAuthor Commented:
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
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Per your original code this affects the selected mail ... and only if there is one mail selected
0
 
jegajothyretiredAuthor Commented:
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
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.