Sending Outlook Email with Actions (Approve/Disapprove) Boxes

[JM]

Hello,

I am working on a purchase request form and would like to be able to
email the form when filled out to a supervisor, with an approve and
disapprove action that would open up another outlook form. Does anyone
know if this is possible. I can send the email with attached report no
problem, but I don't know if it is even possible to specify actions on
the outlook message.


Here is the code I am using so far, to send the email:

Option Explicit

Private Sub Command28_Click()
sbSendMessage

End Sub
Sub sbSendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

On Error GoTo ErrorMsgs

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message. Substitute
' your names here.
Set objOutlookRecip = .Recipients.Add("Smith, John")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Smith, Tom")
objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Last test." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
'.........End If
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
ErrorMsgs:
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
MsgBox Err.Number, Err.Description
End If
End Sub


Thanks,
JM

 

[Graham Mandeno]

Hi JM

Set the VotingOptions property on your MailItem before sending it:
.Importance = olImportanceHigh 'High importance
.VotingOptions = "Approve;Disapprove"

Also, a couple of other points:

1. Your code will always pass through your error handler. You don't want
that!

2. If an error occurs, the cleanup code won't execute.

3. Your use of MsgBox to display the error message is incorrect.

Fixed code is below (changed/added lines marked <<<<<)

.Send
End With
CleanUp: <<<<<
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
Exit Sub <<<<<
ErrorMsgs:
If Err.Number = 287 Then <<<<<
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number <<<<<
End If
Resume CleanUp <<<<<
End Sub

Also, to avoid the Outlook security message, you might like to try Outlook
redemption:
http://www.dimastr.com/redemption/