VB Script to process email. Multiple Item selection changing mail format.

larspanky
larspanky used Ask the Experts™
on
I have been working on this macro and it seems like it was working except for an odd problem.  The script works great until I added in

Application.ActiveExplorer.Selection

If I comment out the For IntCount = Applicaiton.... It works fine, on the currently selected item.  If I put the loop in it appears to work on the selected items except it generates new mail, rather than forwarding the message.   This is leaving me with a formatting problem.  

I need to be able to select multiple items and have the script run on each item as if its not running a loop.  Not sure what to do here, any ideas will be helpful.  
Sub ADDSPAM()
    On Error Resume Next
    'Set current Object Variable objMail
    Dim objMail As Outlook.mailItem
    'Set Rcommand Variable
    Dim Rcommand$, intProcessed$
    Dim objFolder As Outlook.Folder   '<<<<<
    Dim objItem As Outlook.mailItem, myFolder As Outlook.Folder
    'MsgBox "ons=" & objNS.CurrentUser
        
    Set myFolder = Session.GetDefaultFolder(olFolderInbox)
    'MsgBox "myf=" & myFolder.Name
        
    Set myParentFolder = myFolder.Parent
    'MsgBox "mypf=" & myParentFolder.Name & "...count=" & myParentFolder.Folders.Count
        
    Set objFolder = myParentFolder.Folders.Item("~Filtered Spam")  '<<<<<<
    
    'Rcommand command, change here
    Rcommand = "ADDASSPAMTEST"
    intProcessed = Application.ActiveExplorer.Selection.Count
    For intCount = Application.ActiveExplorer.Selection.Count To 1 Step -1
        Set objMail = Application.ActiveExplorer.Selection.Item(intCount)
        objMail.UnRead = True
        objMail.To = "rcommands@mailessentials.com"
        objMail.Body = Rcommand & ";" & vbCrLf & objMail.Body
        'objMail.Display
        objMail.Move objFolder
        objMail.Send
    Next
MsgBox intProcessed & " items processed successfully"
    Set objItem = Nothing
    Set objMail = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Author

Commented:
The problem seems to be in the forwarding.  When the script runs on one item it forwards properly.  If on multiple items it generates a new message and sends that.   The formatting difference is subtle but it makes it not work.  

Author

Commented:
When multiples are selected this is what I get back

Delivery has failed to these recipients or groups:

rcommands@mailessentials.com
You can't send a message on behalf of this user unless you have permission to do so. Please make sure you're sending on behalf of the correct sender, or request the necessary permission. If the problem continues, please contact your helpdesk.








Diagnostic information for administrators:

Generating server:

rcommands@mailessentials.com
#MSEXCH:MSExchangeIS:/DC=com/DC=keyisit:GEMINI2[578:0x000004DC:0x0000001D] #SMTP#
Top Expert 2010

Commented:
Hi, larspanky.

I'm not clear on what's not working.  The loop is already set to process all selected items and it does the same thing to each item.  I don't see how it can work for a single item and fail for multiple items when it performs the same action regardless of the number of items selected.
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
Hello Again,

Here is an example.
This uses GetCurrentItem() and objItem.forward and then enters some command syntax and sends it off.  I commented out the for each line because it was not working.

When I run this, it forwards the message and it is correct.

The code running the loop generates the second message.  Its not a forward, its a new message, and I get an NDR from exchange (Picture 3)

Somehow the ADDSPAM() code is generating these new messages rather than forwarding the original.  The messages look almost the same but it makes it not work.  

Not sure what to do
Sub WHITELISTDOMAIN()
On Error Resume Next
'Declare current Object Variable objMail
Dim objMail As Outlook.mailItem
'Declare Rcommand Variables
Dim Rcommand$, objReply$, username$, domainName$
'Rcommand command, change here
Rcommand = "ADDWLISTTEST:"
Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
objReply = objItem.SenderEmailAddress
username = Mid(objReply, 1, InStr(objReply, "@"))
domainName = Mid(objReply, InStr(objReply, "@") + 1)
'For Each objMail In Application.ActiveExplorer.Selection
objMail.To = "rcommands@mailessentials.com"
objMail.Body = Rcommand & "*@" & domainName & ";" & vbNewLine & vbNewLine & objMail.Body
'Comment objMail.Display to Stop Display
'objMail.Display
'DELETE Comment ' to send
objMail.Send
'Next
MsgBox "Domain White List Processed"
Set objItem = Nothing
Set objMail = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

End Sub
End Sub

Open in new window

GoodMail.jpg
BadMail.jpg
NDR.jpg
Ok I just added

Set objItem = Application.ActiveExplorer.Selection.Item(intCount)
        Set objMail = objItem.Forward

and It looks like its working, I am testing now.

Author

Commented:
That worked.  

I am all set on this one.
Top Expert 2010

Commented:
Great.  Glad you worked it out.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial