Sign and Encrypt Emails on Custom Form

[ben.agnoli]

Hi,

I have a custom Outlook 2003 form, Used for automatically checking the
Sign & Encrypt buttons on a standard email. This code works fine,
however when sending to someone who does not have a Microsoft Email
Client, they recieve any attachments as a winmail.dat file.

I have posted the code below:


=======================================================
Option Explicit

Function Item_Send()
On Error Resume Next
Dim oDigSignCtl
Dim oCBs

Set oDigSignCtl = Item.GetInspector.CommandBars.FindControl(, 719)

If oDigSignCtl Is Nothing Then
' Add the toolbar button to the item.
Set oCBs = Item.GetInspector.CommandBars
Set oDigSignCtl = oCBs.Item("Standard").Controls.Add(,
719,,,True)
End If

' Check to make sure the button is not dimmed.
If oDigSignCtl.Enabled = True Then
' Check to make sure the button is not depressed.
If oDigSignCtl.State = 0 Then oDigSignCtl.Execute
Else
MsgBox "You do not have a digital signature! " & _
"This mail will not be sent."
' Cancel the send to only allow sending of signed mail.
Item_Send = False
Exit Function
End If

Set oCBs = Nothing
Set oDigSignCtl = Nothing
Set oDigSignCtl = Item.GetInspector.CommandBars.FindControl(, 718)

If oDigSignCtl Is Nothing Then
' Add the toolbar button to the item.
Set oCBs = Item.GetInspector.CommandBars
Set oDigSignCtl = oCBs.Item("Standard").Controls.Add(,
718,,,True)
End If

' Check to make sure the button is not dimmed.
If oDigSignCtl.Enabled = True Then
' Check to make sure the button is not depressed.
If oDigSignCtl.State = 0 Then oDigSignCtl.Execute
Else
MsgBox "You cannot encrypt this message! " & _
"This mail will not be sent."
' Cancel the send to only allow sending of signed mail.
Item_Send = False
Exit Function
End If

Set oCBs = Nothing
Set oDigSignCtl = Nothing


dim objFolder
Dim fldr
Dim i
Dim objNS
dim strFolderPath
dim aFolders
dim Copied

strFolderPath = Replace("Public Folders/All Public
Folders/Dispatch/Jobs Sent", "/", "\")
aFolders = Split("Public Folders\All Public Folders\Dispatch\Jobs
Sent", "\")

'get the Outlook objects
' use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit Function
Next
Set objFolder = fldr
'Item.Save
set Copied = item.copy
Copied.Move objFolder
Set objNS = Nothing
Set objFolder = Nothing
'msgbox("YOU HAVE GOT HERE")

If Err.number <> 0 Then
msgbox "An error occurred. Please contact IT Support."
Item_Send = false
Else

End If
End Function
=======================================================

After much experientation, I have discovered that the following line is
causing the problems:
If oDigSignCtl.State = 0 Then oDigSignCtl.Execute
since if I comment out these lines, the email arrives correctly.

Is there another way to ensure that an email is sent encrypted? or a
workaround for this problem?

Many Thanks in advance,

Ben.