URGENT - Help w/Redemption forwarding

[noone]

Below is the problem area of the code, I am getting a "method not supported"
error.

Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = oExp.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "(e-mail address removed)"
.Body
.Send
End With

This is the entire code (minus the version functions, registry stuff, etc.)
I cannot seem to get SendKeys working since I converted this over to
a COM object instead of a VBA macro.

Am I DIMming something wrong ? Or forgetting something ?
Go easy on me, I'm new to Outlook/VBA/COM stuff.

Dim objApp As Application
Dim objSelection As Selection
Dim objExplorer As Object
Dim objItem As Object

'requires Microsoft DAO 3.6 Object Library reference
Dim db As Database 'database
Dim strSQL As String 'database
Dim strDomain, strEmail As String 'database

Dim sKey As String
Dim sValue As String
Dim vSetting As Variant
Dim vOrigSetting As Variant

Dim sType As Long
Dim pid_ver As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Msg = "Process these email(s) as SPAM ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Anti-Spam"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then

Set db = DBEngine.Workspaces(0).OpenDatabase("X:\Installs\Outlook
Anti-Spam\config.mdb") 'database

If Len("C:\Program Files\Microsoft Office\Office\outlook.exe") Then
pid_ver = fGetProductVersion("C:\Program Files\Microsoft
Office\Office\outlook.exe")
If Left(pid_ver, 1) = "9" Then
sKey =
"Software\Microsoft\Office\9.0\Outlook\Options\Spelling"
sValue = "Check"
End If
End If

If Len("C:\Program Files\Microsoft Office\Office10\outlook.exe")
Then
pid_ver = fGetProductVersion("C:\Program Files\Microsoft
Office\Office10\outlook.exe")
If Left(pid_ver, 1) = "1" Then
sKey =
"Software\Microsoft\Office\10.0\Outlook\Options\Spelling"
sValue = "Check"
End If
End If

vSetting = QueryValue(HKEY_CURRENT_USER, sKey, sValue)
vOrigSetting = QueryValue(HKEY_CURRENT_USER, sKey, sValue)

If vSetting = 1 Then
If Left(pid_ver, 1) = "9" Then
SendKeys "%TO"
SendKeys
"{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{RIGHT}{RIGHT}{RIGHT}"
SendKeys "{TAB}{TAB}"
SendKeys " "
SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{ENTER}"
End If

If Left(pid_ver, 1) = "1" Then
SendKeys "%TO"
SendKeys
"{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{RIGHT}{RIGHT}{RIGHT}"
SendKeys "{TAB}{TAB}"
SendKeys " "
SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{ENTER}"
End If
End If

Dim oExp As Outlook.Explorer
Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection

Select Case objSelection.Count

Case 0
Case Is > 1
For Each objItem In objSelection
If TypeOf objItem Is MailItem Then

strEmail = R_GetSenderAddress(objItem) 'database
strDomain = sDomain(strEmail)

strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')" 'database
db.Execute strSQL 'database
End If
Next

Case Is <= 1
For Each objItem In objSelection
If TypeOf objItem Is MailItem Then

strEmail = R_GetSenderAddress(objItem) 'database
strDomain = sDomain(strEmail)

strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')" 'database
db.Execute strSQL 'database

Set SafeItem =
CreateObject("Redemption.SafeMailItem")
Set myForward =
oExp.Selection.Item(1).Forward
SafeItem.Item = myForward
With SafeItem
.Recipients.Add "(e-mail address removed)"
.Body
.Send
End With

End If
Next
End Select

If vOrigSetting = 1 Then
If Left(pid_ver, 1) = "9" Then
SendKeys "%TO"
SendKeys
"{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{RIGHT}{RIGHT}{RIGHT}"
SendKeys "{TAB}{TAB}"
SendKeys " "
SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{ENTER}"
End If

If Left(pid_ver, 1) = "1" Then
SendKeys "%TO"
SendKeys
"{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{RIGHT}{RIGHT}{RIGHT}"
SendKeys "{TAB}{TAB}"
SendKeys " "
SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{ENTER}"
End If
End If

db.Close 'database

End If 'msgbox

Set objApp = Nothing
Set objSelection = Nothing
Set objItem = Nothing

Thanks everyone =)

 

[Sue Mosher [MVP]]

Which specific statement triggers the error? Other comments below:

Below is the problem area of the code, I am getting a "method not supported"
error.

Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set myForward = oExp.Selection.Item(1).Forward

You have no way of knowing whether an item is actually selected. Try to get the item first, then forward only when you know you have it:

On Error Resume Next
Set objItem = oExp.Selection.Item(1)
If not objItem Is Nothing Then
' OK to continue

SafeItem.Item = myForward

In general you need to save an item before setting it as the Item for a Redemption safe object.

With SafeItem
.Recipients.Add "(e-mail address removed)"
.Body

This statement is incomplete. It should be:

.Body = "whatever text you want to appear in the body"

.Send
End With

This is the entire code (minus the version functions, registry stuff, etc.)

I cannot seem to get SendKeys working since I converted this over to
a COM object instead of a VBA macro.

It's virtually impossible for someone who didn't write the code to debug long SendKeys sequences.

Am I DIMming something wrong ? Or forgetting something ?

I can't tell from these lines how you've instantiated the Outlook object:

Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection

You should use the Application object passed in the OnConnection event of your COM addin.

 

[noone]

I was hoping that you would reply

All is working now, I just needed to add the = "Forwarded" to the body line,
i.e. .Body = "Forwarded via Outlook Anti-Spam"

Now I'm going to explore/search on how to forward the original message
body instead of what I typed in above.

Thanks for all your help.