Forums  Register  Login  My Profile  Inbox  Address Book  My Subscription  My Forums 

Member List  Search  FAQ  Ticket List  Log Out

 

Outlook Macros

  		Logged in as: Guest
Users viewing this topic: none
  Printable Version
All Forums >> [Web & Mail Security] >> GFI MailEssentials >> Outlook Macros Page: [1] 2 3   next >   >>
Login
Message << Older Topic   Newer Topic >>
Outlook Macros - 17.Sep.2003 11:19:00 AM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		I am thinking of writing some macros for Outlook 2002 to automate the forwarding of emails to rcommands@mailessentials.com for adding messages to the Black List or adding to the Bayesian Filter database (good or bad).

Rather than reinvent the wheel I wondered if anyone had done this or maybe had some URLs they could suggest to get me started in the right direction - I am familiar with VBA and VBScript but have never written a macro for Outlook.

Alex
Post #: 1
RE: Outlook Macros - 17.Sep.2003 4:32:00 PM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Well I went ahead and did it anyway - if anyone wants macros that (should) work in Outlook 2000/2002 let me know and I'll email them/post them here.

One minor caveat: you need to install 'Redemption' from http://www.dimastr.com/redemption/ for them to work. Using Redemption allowed sending email without the annoying 5 second wait for every message.

There are 4 macros that report any selected message as follows:
HAM
SPAM
BLACKLIST
SPAM & BLACKLIST

(in reply to alexdavidson)
Post #: 2
RE: Outlook Macros - 17.Sep.2003 8:02:00 PM   
wchurchman

 

Posts: 64
Joined: 15.Sep.2003
Status: offline 		Yes, I've been thinking about writing the macros myself. I'd be happy if you posted them. It would save me some work.

Thanks,

Wayne

(in reply to alexdavidson)
Post #: 3
RE: Outlook Macros - 18.Sep.2003 12:38:00 AM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Note that in BlackList() I am doing some checking of who is running the macro - if it is one of 3 admins (alex, peter or josh) then they are allowed to black list a whole domain, otherwise it's assumed they are only blocking the address in question. I didn't want a 'regular' user to inadvertantly block a domain like hotmail.com and cause all kinds of problems.
I have yet to add this functionality to the combined routine SpamAndBlackList() but I'm sure you can do it yourself given the code.

Function GetAddress()
Set objExplorer = Application.ActiveExplorer
Set objSelected = objExplorer.Selection
Set objItem = objSelected.Item(objSelected.Count)
Set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = objItem
PrSenderEmail = &HC1F001E
GetAddress = sItem.Fields(PrSenderEmail)
End Function

Sub BlackList()
varAddress1 = GetAddress()
varDomain = Mid(varAddress1, InStr(varAddress1, "@") + 1)
varSMIUser = GetCurrentUser()
If varSMIUser = "alexd" Or varSMIUser = "joshc" Or varSMIUser = "peterb" Then
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varAddress1 & vbCr & "to the Black List", 291, "Add Address To Black List")
Else
varReturn = 7
End If
If varReturn <> 2 Then
If varReturn = 6 Then
varAddress1 = "*@" & varDomain
End If
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress1 & ";"
.Send
End With
objExplorer.Selection.Item(1).Delete
End If
End If
End Sub

Function GetCurrentUser()
Dim CU
Set CU = CreateObject("Redemption.SafeCurrentUser")
varUserName = Mid(CU.Address, InStrRev(CU.Address, "=") + 1)
GetCurrentUser = varUserName
CU.Cleanup
Set CU = Nothing
End Function

Sub SpamAndBlackList()
' Spam Notification For Bayesian Filter
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
End If
' Black List
varAddress2 = GetAddress()
varDomain = Mid(varAddress2, InStr(varAddress2, "@") + 1)
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varAddress2 & vbCr & "to the Black List", 291, "Add Address To Black List")
If varReturn <> 2 Then
If varReturn = 6 Then
varAddress2 = "*@" & varDomain
End If
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress2 & ";"
.Send
End With
objExplorer.Selection.Item(1).Delete
End If
End If
End Sub

Sub AddSpamToFilter()
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
objExplorer.Selection.Item(1).Delete
End If
End Sub

Sub AddHamToFilter()
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASGOODMAIL" & vbCr & varOriginalBody
.Send
End With
objExplorer.Selection.Item(1).Delete
End If
End Sub

(in reply to alexdavidson)
Post #: 4
RE: Outlook Macros - 18.Sep.2003 11:26:00 AM   
wchurchman

 

Posts: 64
Joined: 15.Sep.2003
Status: offline 		Alex,

Thanks for posting the code. I got it working except for one thing: VB seems to choke on this line (inside the With Safeitem stucture):

.BodyFormat = olFormatPlain

I can't find a reference to either that property or the constant in VB 6. Is it something that was added in a later version?

Thanks again for your help.

Wayne

(in reply to alexdavidson)
Post #: 5
RE: Outlook Macros - 18.Sep.2003 11:30:00 AM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Strange - it works fine for me.

Let's make sure we're on the same page:
1. You open Outlook
2. You hit ALT-F11 to open the Visual Basic Editor
3. You Paste the text into Module1 under the Modules folder

Maybe you're not using Outlook 2002? We're not on the same SR/SP?

(in reply to alexdavidson)
Post #: 6
RE: Outlook Macros - 18.Sep.2003 11:46:00 AM   
wchurchman

 

Posts: 64
Joined: 15.Sep.2003
Status: offline 		I think that's it, I'm running Outlook 2000. I've commented out that line and it seems to work just fine. Thanks again for your post.

Wayne

(in reply to alexdavidson)
Post #: 7
RE: Outlook Macros - 18.Sep.2003 11:55:00 AM   
orutra

 

Posts: 11
Joined: 27.Aug.2003
From: SPAIN
Status: offline 		I will use different public folders for each rcommand. An event in Exchange server send the associated message to rcommand@mailessentials.com when a user drag and drop a mail in the folder.
My draft code is running but it include html tags that this form rejects.
This is a corrected version.

'------------------------------------------------------------------------------
'FILE DESCRIPTION: COMANDOS AI
'------------------------------------------------------------------------------

Option Explicit

' DESCRIPTION: This event is fired when a new message is added to the folder
Public Sub Folder_OnMessageCreated
dim ObjSesion
dim objCarpeta
dim objMensaje
dim StoreId
dim objMsgMandato
dim destino
dim BodyHtml
dim texto
dim saltolinea
dim receptor
dim auxCC
StoreId=""

with EventDetails
set ObjSesion=.Session
set objCarpeta=objSesion.getFolder(.FolderId,storeId)
set objMensaje=objSesion.getMessage(.MessageId,StoreId)
end with
texto= ""
saltolinea=chr(10)
Texto=texto & "PASSWORD: 1234567890;" & SaltoLinea
if objCarpeta.name="Esto es Spam" then
texto= texto & "ADDASSPAM;"
else
texto= texto & "ADDASGOODMAIL;"
end if
texto=texto & saltolinea
texto=texto & "----Original Message----" & SaltoLinea
texto=texto & "From: " & objMensaje.sender.name & " [" & objMensaje.sender.address & "]" & SaltoLinea
texto=texto & "To: "
for each receptor in objMensaje.recipients
select case receptor.type
case 1:
texto=texto & receptor.address & ";"
case 2:
auxCC=auxCC & auxCC.address & ";"
end select
next
texto=texto & saltoLinea
texto=texto & "CCO: " & auxCC & SaltoLinea
texto=texto & "Subject: " & objMensaje.subject & saltolinea
texto=texto & objmensaje.text
set objMsgMandato=objsesion.outbox.messages.add
objMsgMandato.text=texto
objMsgMandato.subject="FWD: " & objMensaje.subject
set destino= objMsgMandato.recipients.add ("","smtp:rcommands@mailessentials.com",1)
destino.resolve
objmsgMandato.send
objMensaje.delete
End Sub

(in reply to alexdavidson)
Post #: 8
RE: Outlook Macros - 18.Sep.2003 12:33:00 PM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Arturo,
I like your idea a LOT.
One thing I'm just discovering with the whole Macro thing is that I have to sign it using a Digital Signing Certificate ($199/yr is the cheapest I've found from Thawte) and then each user has to say it's okay to trust code signed by 'us' otherwise every time they open Outlook they are asked whether they want to enable or block the macros it has detected.

I suppose another way would be to 'write' (copy and paste) the code into each user's Outlook Module and self-certify it using selfcert.exe - same process as before with approving at each person's workstation but it means the code is not centralized and that the install is a little longer :-/

How and where do you assign the code you have?
I want to try this way as a substitute.

Does the code you supplied currently work or is it still having a problem with the HTML?

Alex

(in reply to alexdavidson)
Post #: 9
RE: Outlook Macros - 18.Sep.2003 5:02:00 PM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Well I cleaned up my code a bit and also added a couple of things like:
1. Deletes the email that is sent to the server from Sent Items
2. Moves Ham to the Inbox

Here's the final code.

Arturo - gimme the scoop on your solution.

Alex

(in reply to alexdavidson)
Post #: 10
RE: Outlook Macros - 18.Sep.2003 7:12:00 PM   
wchurchman

 

Posts: 64
Joined: 15.Sep.2003
Status: offline 		Alex,

I didn't see the final code in your last post, but would like to see the refinements that you've made.

Can you post the final code or email it to me (see my profile)?

You are the macro king!

Wayne

(in reply to alexdavidson)
Post #: 11
RE: Outlook Macros - 18.Sep.2003 7:22:00 PM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Sorry - not sure what happened:

'Option Explicit

Function GetAddress()
Set objExplorer = Application.ActiveExplorer
Set objSelected = objExplorer.Selection
Set objItem = objSelected.Item(objSelected.Count)
Set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = objItem
PrSenderEmail = &HC1F001E
GetAddress = sItem.Fields(PrSenderEmail)
End Function
Sub BlackList()
varAddress1 = GetAddress()
varDomain = Mid(varAddress1, InStr(varAddress1, "@") + 1)
varSMIUser = GetCurrentUser()
If varSMIUser = "alexd" Or varSMIUser = "joshc" Or varSMIUser = "peterb" Then
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varAddress1 & vbCr & "to the Black List", 291, "Add Address To Black List")
Else
varReturn = 7
End If
If varReturn <> 2 Then
If varReturn = 6 Then
varAddress1 = "*@" & varDomain
End If
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress1 & ";"
.Send
End With
objExplorer.Selection.Item(1).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
End If
End If
End Sub

Function GetCurrentUser()
Dim CU
Set CU = CreateObject("Redemption.SafeCurrentUser")
varUserName = Mid(CU.Address, InStrRev(CU.Address, "=") + 1)
GetCurrentUser = varUserName
'MsgBox CU.Address
CU.Cleanup 'do call cleanup, otherwise Outlook might have trouble properly closing down
Set CU = Nothing
End Function

Sub SpamAndBlackList()
' Spam Notification For Bayesian Filter
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
'Set myOlApp = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApp.GetNamespace("MAPI")
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
'myFolder.Items.Item(1).Delete
End If
' Black List
varAddress2 = GetAddress()
varDomain = Mid(varAddress2, InStr(varAddress2, "@") + 1)
varSMIUser = GetCurrentUser()
If varSMIUser = "alexd" Or varSMIUser = "joshc" Or varSMIUser = "peterb" Then
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varAddress2 & vbCr & "to the Black List", 291, "Add Address To Black List")
Else
varReturn = 7
End If
If varReturn <> 2 Then
If varReturn = 6 Then
varAddress2 = "*@" & varDomain
End If
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress2 & ";"
.Send
End With
objExplorer.Selection.Item(1).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
myFolder.Items.Item(1).Delete
End If
End If
End Sub

Sub AddSpamToFilter()
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
objExplorer.Selection.Item(1).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
End If
End Sub
Sub AddHamToFilter()
Set objExplorer = Application.ActiveExplorer
If objExplorer.Selection.Count > 0 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(1).Forward
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASGOODMAIL" & vbCr & varOriginalBody
.Send
End With
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
objExplorer.Selection.Item(1).Move myNameSpace.GetDefaultFolder(6)
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
End If
End Sub

(in reply to alexdavidson)
Post #: 12
RE: Outlook Macros - 10.Oct.2003 7:02:00 PM   
alexdavidson

 

Posts: 64
Joined: 12.Sep.2003
From: Denver
Status: offline 		Thought I should share the latest version of my macros. It now detects three power users (alexd, josh or peterb) and allows them to block entire domains (including *@*.domain.com if detected):
'Option Explicit

Function GetAddress(varLoop)
Set objExplorer = Application.ActiveExplorer
Set objSelected = objExplorer.Selection
'Set objItem = objSelected.Item(objSelected.Count)
Set objItem = objSelected.Item(varLoop)
Set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = objItem
PrSenderEmail = &HC1F001E
GetAddress = sItem.Fields(PrSenderEmail)
End Function
Sub BlackList()
Set objExplorer = Application.ActiveExplorer
On Error GoTo PULLOUT
If objExplorer.Selection.Count > 0 Then
On Error GoTo 0
For varLoop = 1 To objExplorer.Selection.Count
varAddress1 = GetAddress(varLoop)
varDomain = Mid(varAddress1, InStr(varAddress1, "@") + 1)
varSMIUser = UCase(GetCurrentUser())
If varSMIUser = "ALEXD" Or varSMIUser = "JOSHC" Or varSMIUser = "PETERB" Then
varDotCount = 0
For varLoopAddress = 1 To Len(varDomain)
If Mid(varDomain, varLoopAddress, 1) = "." Then
varDotCount = varDotCount + 1
End If
Next
If varDotCount = 2 Then
varTempAddress = varAddress1
varDomain2 = "*@*" & Mid(varDomain, InStr(varDomain, "."))
Else
varTempAddress = varAddress1
varDomain2 = "*@" & varDomain
End If
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain2 & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varTempAddress & vbCr & "to the Black List", 291, "Add Address To Black List")
If varReturn = 7 Then
varAddress1 = varTempAddress
Else
varAddress1 = varDomain2
End If
Else
varReturn = 7
End If
If varReturn <> 2 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(varLoop).Forward
Set myattachments = myForward.Attachments
If Not TypeName(myattachments) = "Nothing" Then
While myattachments.Count > 0
myattachments.Remove 1
Wend
End If
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress1 & ";"
.Send
End With
objExplorer.Selection.Item(varLoop).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
End If
Next
PULLOUT:
On Error GoTo 0
End If
End Sub

Function GetCurrentUser()
Dim CU
Set CU = CreateObject("Redemption.SafeCurrentUser")
varUserName = Mid(CU.Address, InStrRev(CU.Address, "=") + 1)
GetCurrentUser = varUserName
'MsgBox CU.Address
CU.Cleanup 'do call cleanup, otherwise Outlook might have trouble properly closing down
Set CU = Nothing
End Function

Sub SpamAndBlackList()
Set myOlApp = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApp.GetNamespace("MAPI")
' If myOlApp.ActiveExplorer.CurrentFolder = "Inbox" Then
' Spam Notification For Bayesian Filter
Set objExplorer = Application.ActiveExplorer
On Error GoTo PULLOUT
If objExplorer.Selection.Count > 0 Then
On Error GoTo 0
For varLoop = 1 To objExplorer.Selection.Count
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(varLoop).Forward
Set myattachments = myForward.Attachments
If Not TypeName(myattachments) = "Nothing" Then
While myattachments.Count > 0
myattachments.Remove 1
Wend
End If
myForward.Save
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
'Set myOlApp = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApp.GetNamespace("MAPI")
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
'myFolder.Items.Item(varLoop).Delete
'End If
' Black List
varAddress2 = GetAddress(varLoop)
varDomain = Mid(varAddress2, InStr(varAddress2, "@") + 1)
varSMIUser = UCase(GetCurrentUser())
If varSMIUser = "ALEXD" Or varSMIUser = "JOSHC" Or varSMIUser = "PETERB" Then
varDotCount = 0
For varLoopAddress = 1 To Len(varDomain)
If Mid(varDomain, varLoopAddress, 1) = "." Then
varDotCount = varDotCount + 1
End If
Next
If varDotCount = 2 Then
varTempAddress = varAddress2
varDomain2 = "*@*" & Mid(varDomain, InStr(varDomain, "."))
Else
varTempAddress = varAddress2
varDomain2 = "*@" & varDomain
End If
varReturn = MsgBox("Do you want to add the sender's whole domain:" & vbCr & varDomain2 & vbCr & "to the Black List?" & vbCr & vbCr & "Saying No will add only the sender's address:" & vbCr & varTempAddress & vbCr & "to the Black List", 291, "Add Address To Black List")
If varReturn = 7 Then
varAddress2 = varTempAddress
Else
varAddress2 = varDomain2
End If
Else
varReturn = 7
End If
If varReturn <> 2 Then
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(varLoop).Forward
Set myattachments = myForward.Attachments
If Not TypeName(myattachments) = "Nothing" Then
While myattachments.Count > 0
myattachments.Remove 1
Wend
End If
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
.BodyFormat = olFormatPlain
.Body = "ADDBLIST: " & varAddress2 & ";"
.Send
End With
objExplorer.Selection.Item(varLoop).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
myFolder.Items.Item(1).Delete
End If
Next
PULLOUT:
On Error GoTo 0
End If
' End If
End Sub

Sub AddSpamToFilter()
Set objExplorer = Application.ActiveExplorer
On Error GoTo PULLOUT
If objExplorer.Selection.Count > 0 Then
On Error GoTo 0
For varLoop = 1 To objExplorer.Selection.Count
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(varLoop).Forward
myForward.Save
Set myattachments = myForward.Attachments
If Not TypeName(myattachments) = "Nothing" Then
While myattachments.Count > 0
myattachments.Remove 1
Wend
End If
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASSPAM" & vbCr & varOriginalBody
.Send
End With
objExplorer.Selection.Item(varLoop).Delete
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
Next
PULLOUT:
On Error GoTo 0
End If
End Sub
Sub AddHamToFilter()
Set objExplorer = Application.ActiveExplorer
On Error GoTo PULLOUT
If objExplorer.Selection.Count > 0 Then
On Error GoTo 0
For varLoop = 1 To objExplorer.Selection.Count
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = objExplorer.Selection.Item(varLoop).Forward
myForward.Save
Set myattachments = myForward.Attachments
If Not TypeName(myattachments) = "Nothing" Then
While myattachments.Count > 0
myattachments.Remove 1
Wend
End If
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "rcommands@mailessentials.com"
varOriginalBody = SafeItem.Body
.Body = "ADDASGOODMAIL" & vbCr & varOriginalBody
.Send
End With
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
If myOlApp.ActiveExplorer.CurrentFolder <> "Inbox" Then
'Set myOlApp = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApp.GetNamespace("MAPI")
objExplorer.Selection.Item(varLoop).Move myNameSpace.GetDefaultFolder(6)
End If
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
myFolder.Items.Item(1).Delete
Next
End If
PULLOUT:
On Error GoTo 0
End Sub

(in reply to alexdavidson)
Post #: 13
RE: Outlook Macros - 16.Oct.2003 1:05:00 PM   
BarryC

 

Posts: 55
Joined: 15.Oct.2003
From: New York City
Status: offline 		Alex,

Thanks for taking the time to create refine these macros. While I'm still testing them, it appears that they do work.

One thing everyone should be aware of though: To use Redemption in Outlook with recent security patches you should obtain the Office Resource Kit from the Microsoft web site, and install the Outlook Administrator Kit and the Outlook Security Template. You must use this tool to enable Redemption, assuming you're using server based security, which is probable if you're using MailEssentials.

(in reply to alexdavidson)
Post #: 14
RE: Outlook Macros - 16.Oct.2003 1:27:00 PM   
BarryC

 

Posts: 55
Joined: 15.Oct.2003
From: New York City
Status: offline 		I screwed up and posted this as a new topic. Technical difficulties.

find your program works fine when I select a single message for HAM identification (that's the first thing I'm testing) but fails when I select more than one message with the following highlighted in the debugger:

code:
  Set myForward = objExplorer.Selection.Item(varLoop).Forward
This makes sense as it related directly to the issue. I'm not even close to a VB expert, but it seems that the program creates a loop based upon the number of items selected and runs as long as the number is greater than zero(0), so this shouldn't be happening.

If I was a VB expert, I'd fix it myself, but since I'm not I need your help. Clues are as good as a cure.

(in reply to alexdavidson)
Post #: 15
Page:   [1] 2 3   next >   >>
All Forums >> [Web & Mail Security] >> GFI MailEssentials >> Outlook Macros Page: [1] 2 3   next >   >>
Jump to:





New Messages No New Messages
Hot Topic w/ New Messages Hot Topic w/o New Messages
Locked w/ New Messages Locked w/o New Messages
 Post New Thread
 Reply to Message
 Post New Poll
 Submit Vote
 Delete My Own Post
 Delete My Own Thread
 Rate Posts