Resolving Addresses With Redemption

[mrfitness]

I am using redemption code vba to send emails in my excel application (apparently a safer way to email using vba)

The code is intended for users and therefore the emails would be sent by the code instead of the user (to avoid any tampering, etc by the user with sensitive information in the email)

The main issue I am having is getting the excel vba code to resolve email names/groups without having the Outlook security warning pop up, as well as the issue of having the email get sent before the names/groups are resolved (which causes Error Number: -2147418113: "Could not resolve the message recipients" - even though the address is legitimate).

I have simplified my code and hard coded my email variables for this example, using fake addresses instead of group names. I also replaced the .SEND command with the .DISPLAY command to view if the addresses have been resolved or not. In actuality the email addresses will be different group names that, if not resolved, would cause an error when sending with the .SEND command. (as noted in the previous paragraph)

Sub email() 
	Dim OL_App As Object 
	Dim OL_item As Object 
	Dim namespace 
	Dim SafeItem, oItem, ccRecip 
 
	Set OL_App = CreateObject("Outlook.Application") 
	Set ol_item = OL_App.CreateItem(0) 'Create a new message
 
	Set namespace = OL_App.GetNamespace("MAPI") 
	namespace.Logon 
 
	Set SafeItem = CreateObject("Redemption.safeMailItem") 
 
	SafeItem.Item = ol_item 'set Item property
 
	strTo = "[email="[email protected]"][email protected][/email]; [email="[email protected]"][email protected][/email]" 'these would actually be a group name
	StrCC = "[email="[email protected]"][email protected][/email]; [email="[email protected]"][email protected][/email]" 'these would actually be a group name
	strBody = "testing it out" 
	strSubject = "Will it do it?" 
 
	With SafeItem.Item 
		.Subject = strSubject 
		.To = strTo 
		.CC = StrCC 
		.Body = strBody 
		.Recipients.ResolveAll 'security msg pops up from this line!!!!
		.Display 
 
	End With 
 
	Set OL_App = Nothing 
	Set SafeItem = Nothing 
 
End Sub

However, If i change the "With SafeItem.Item" statement to "With SafeItem" only (removing the ".Item" at the end), the email does display but it does not seem to be resolving, hence no security pop up appears. ("SafeItem.Recipients.ResolveAll" does not seem to be doing anything actually.)

How can I resolve the addresses without getting the outlook warning?

 

[mrfitness]

solving the resolving!

Ok I figured out how to do it so im posting the answer here for anyone else who is having this problem, as it took me a LOT of trial and error.

In my example, I have the addresses to email on "sheet1" of the workbook. The TO line addressess are in cell A1, and the CC line addresses are in cell A2. I have semi colons (";") seperating the email address names/groups, without spaces. (You could use cell A3 for email subject and cell A4 for email body but I chose not to in this example)

ie cell A1 is (e-mail address removed) (could also be a group name- ie "forum_group")

You can have as many email addresses as you want in either cell A1 or A2, as I have a loop that uses Instr() function and ubound() to add each one.

Sub resolve_email()
Dim SafeItem, oItem
Dim OL_App As Object
Dim OL_item As Object
Dim namespace
Dim arrTORecipients() As String
Dim arrCCRecipients() As String
 
Set OL_App = CreateObject("Outlook.Application")
Set OL_item = OL_App.CreateItem(0) 'Create a new message
Set namespace = OL_App.GetNamespace("MAPI")
namespace.Logon
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set oItem = OL_App.CreateItem(0)
SafeItem.Item = oItem
 
strTo = Worksheets("Sheet1").Range("A1").Value
StrCC = Worksheets("Sheet1").Range("A2").Value
 
If InStr(strTo, ";") > 0 Then
arrTORecipients() = Split(strTo, ";")
i = 0
For i = 0 To UBound(arrTORecipients)
'add all the recipients to TO list
	SafeItem.Recipients.Add (arrTORecipients(i))
Next i
	 Else
	'just one recipient
	SafeItem.Recipients.Add (arrCCRecipients(i))
End If
 
If InStr(StrCC, ";") > 0 Then
arrCCRecipients() = Split(StrCC, ";")
j = 0
For j = 0 To UBound(arrCCRecipients)
'add all the recipients to CC list
	Set ccRecip = SafeItem.Recipients.Add(arrCCRecipients(j))
	ccRecip.Type = olCC
Next j
 
	Else
	'just one recipient
	Set ccRecip = SafeItem.Recipients.Add(arrCCRecipients(j))
	ccRecip.Type = olCC
End If
 
SafeItem.Recipients.ResolveAll
SafeItem.Subject = "Testing Redemption"
SafeItem.Body = "Body Email"
SafeItem.Display
Set OL_App = Nothing
Set SafeItem = Nothing
End Sub