Capturing Send Variables without using Application_ItemSend in ThisOutlookSession

Status
Not open for further replies.

accessDatabase

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Hello,

I want to place a custom button in the send window's ribbon which allows me to capture the sender, recipient, subject, body and date/time sent and pass these through to an Access database then send the email as normal.

I have found out how to get these variables using the Application_ItemSend event in ThisOutlookSession. However, I don't want it to happen each time, only when the user selects the Custom button instead of the standard Sent button.

Here's the code I've been using in ThisOutlookSession which has been getting the variables I need:
Code:
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim thisMail As Outlook.MailItem
Dim senderEmail As Variant
Const PR_SMTP_ADDRESS     As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

With Item
Debug.Print .subject
Debug.Print .body
Debug.Print .senderEmailAddress
Debug.Print "Sent On: " & Now()
Set recips = .recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
Debug.Print pa.GetProperty(PR_SMTP_ADDRESS) 'recip.Name & " " &
Next
End With

Thanks in advance!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
There are a couple of ways to do it, but they all use the same basic idea - an If statement...

If you want users to say 'send to access' before sending, use two macros - one to set a value that says 'yes' and add an if statement to the itemsend - if the variable = yes then send to access. The other way is to bring up a dialog each time asking. The if statement sends to access if yes, skips it if no.

Example from How to set a flag to follow up using VBA
prompt$ = "Do you want to flag this message for followup?"
If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Add flag?") = vbYes Then
' do flag
end if
 

accessDatabase

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Hi Diane, thanks for your reply.

When I paste this code into a module I get a compile error on WithEvents saying Only Valid in Object Module. Which parts go in which type of module?

Option Explicit
Dim SetFlag
Private WithEvents olSentItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
Set objNS = Nothing
End Sub

Private Sub olSentItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
Dim prompt As String
If SetFlag = vbYes Then

With Item
.MarkAsTask olMarkThisWeek
' sets a due date in 3 days
.TaskDueDate = Now + 3
.ReminderSet = True
.ReminderTime = Now + 2
.Save
End With
End If
SetFlag = vbNo
End Sub

Sub SayYes()
SetFlag = vbYes
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
did you paste it into thisoutlooksession or a new module? Those macro only work in thisoutlooksession (because they are automatic) - the error is telling you withevents only works in thisoutlooksession.
 

accessDatabase

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Hi,

I've put this code into thisOutlookSession and assigned 'Say Yes' to a custom button on the ribbon. I click that button, then click the Send button, but it's not firing the code. Any suggestions?
Code:
Option Explicit

Dim SetFlag
Private WithEvents olSentItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
Set objNS = Nothing
End Sub

Private Sub olSentItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
Dim prompt As String
Dim recips As Outlook.recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS     As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
If SetFlag = vbYes Then
    With Item
    Debug.Print .subject
    Debug.Print .body
    Debug.Print .senderEmailAddress
    Debug.Print "SentOn: " & Now()
 
          Set recips = .recipients
          For Each recip In recips
            Set pa = recip.PropertyAccessor
            Debug.Print pa.GetProperty(PR_SMTP_ADDRESS)
          Next
 
    End With
End If
SetFlag = vbNo
End Sub

Sub SayYes()
SetFlag = vbYes
End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
         
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
     
    Set objApp = Nothing
End Function
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
if you are using a button, set a value -
Sub SayYes()
SetFlag = "Yes"
End Sub

then use
If SetFlag = "Yes" Then

clear it using
SetFlag = ""
 

accessDatabase

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Hi Diane, yes I've got an IF block in there, unfortunately the Private Sub olSentItems_ItemAdd(ByVal Item As Object) isn't being fired after I've sent an email. Perhaps I've got it set up wrong?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Either restart outlook or click on the application_startup macro and click Run.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Capturing forward event when multiple items are selected Using Outlook 0
Y Capturing Email Addresses in Auto Address Book Using Outlook 1
D Capturing Data from a form into excel Outlook VBA and Custom Forms 1
B Capturing form data Outlook VBA and Custom Forms 1
S Re: Capturing Outlook Forms Events Outlook VBA and Custom Forms 1
D Capturing Outlook Forms Events Outlook VBA and Custom Forms 21
A Unflag Inbox and Flag Inbox with Orange Category After Item is send Outlook VBA and Custom Forms 3
glnz O365 - How to send from acct 2 but showing email name from acct 1 as From - alias? Using Outlook 1
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
diver864 vba for a rule to automatically accept meeting requests with 'vacation' in subject, change to all-day event, change to free, don't send reply Outlook VBA and Custom Forms 1
PGSystemTester VBA To Change AppointmentItem.BusyStatus From MeetingItem Before Send Using Outlook 0
C Synchronizing subscribed folders causes hanging during send/receive process Using Outlook 2
M Extract all links from Outlook email, send to Excel Using Outlook 2
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
O Outlook 365 - suddenly unable to send using Gmail POP3 Using Outlook 10
T After I send a new email, it remains in the Draft folder Using Outlook.com accounts in Outlook 3
B Programmatically force html send and insert clipboard contents into body Outlook VBA and Custom Forms 0
S Change VBA script to send HTML email instead of text Outlook VBA and Custom Forms 3
M ERROR: None of your email accounts could send to this recipient Using Outlook 2
C Send/receive error 80040119 Using Outlook 2
J Send Again NDR Outlook VBA and Custom Forms 1
J Add an Attachment Using an Array and Match first 17 Letters to Matching Template .oft to Send eMail Outlook VBA and Custom Forms 2
ChrisK2 Send email to advertise@slipstick.com fails: "The group advertising isn't set up to receive messages from..." Using Outlook 3
B resend if no reply and send an automatic reminder Outlook VBA and Custom Forms 0
F Send As a Gmail account via outlook Web Using Outlook 3
R auto send email when meeting closes from a shared calendar only Outlook VBA and Custom Forms 2
X Unable to send an email from one account to another on same PC Using Outlook 2
S Meeting Invite arrives from Wrong ("send-as") Sender Using Outlook 1
M VBA to send reminder email if no response Using Outlook 13
D Using a VBA Custom Form to Send Reoccurring Email Upon Task Completion Outlook VBA and Custom Forms 4
M Can't send email in outlook.com Using Outlook 9
R Can't Send calendar share invite Using Outlook 5
R Can't send messages to groups in Outlook Using Outlook 2
J Updating existing entry on shared calendar wants to send update from delegate Using Outlook 0
M Send/Receive error 0x800CCC0F Using Outlook 0
soadfan Outlook won't send e-mail when offline Outlook VBA and Custom Forms 19
B When working on emails in a certain folder, when I hit reply or reply all, I would like it re always reply all and add an email address to send to Outlook VBA and Custom Forms 3
N Outlook 2010 will not send nor receive Using Outlook 4
I Outlook 2013 Send problem - 'Not Responding' forever Using Outlook.com accounts in Outlook 10
K Delay Send and Mail Merge Outlook VBA and Custom Forms 4
A Outlook - Send New 20 Attachments through Email Using Outlook 4
L Outlook 2007 Separate the Send/Receive functions Using Outlook 2
S Send email via SMTP - use transport rules to add to senders inbox (then rule to move to sent items Exchange Server Administration 1
undercover_smother Automatically Forward All Sent Mail and Delete After Send Outlook VBA and Custom Forms 10
L How to automaticlly Send/Receive every 3 mins but override send if send/receive is pressed Using Outlook 2
D Delay Send not working Using Outlook 3
F Send multiple batch tasks to single person Using Outlook 3
R Prompt asking the user to send email to folder as *.msg file Outlook VBA and Custom Forms 1
stephen li VBA Outlook send mail automatically by specified outlook mail box Outlook VBA and Custom Forms 1
D Default Send Account that Works? Using Outlook 0

Similar threads

Top