I am writing a script in Outlook VBA to record every email in an Access database as they come in to my inbox. The code I have triggers with no issue. It accesses the Access database with no issue. It copies the subject across with no issue. Then it gets to the body and copies nothing at all. I have tried things like .HTMLbody instead of just .Body, but this again shows an empty body. My code is as follows:
Option Explicit
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim objNS As Outlook.NameSpace
Dim objEmail As Outlook.MailItem
Dim strIDs() As String
Dim intX As Integer
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim sDb As String
Dim sSQL As String
Dim qdf As QueryDef
strIDs = Split(EntryIDCollection, ",")
For intX = 0 To UBound(strIDs)
Set objNS = Application.GetNamespace("MAPI")
Set objEmail = objNS.GetItemFromID(strIDs(intX))
sDb = "C:\Users\######\Documents\EmailDatabase.accdb"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(sDb)
sSQL = "INSERT INTO AllEmails (Subject,Message) Values ('" & objEmail.Subject & "','" & objEmail.HTMLBody & "')"
Set qdf = db.CreateQueryDef("", sSQL)
qdf.Execute dbFailOnErro
MsgBox objEmail.HTMLBody
Next
Set objEmail = Nothing
End Sub
If anyone has any idea what I am doing wrong please do let me know. Three hours of googling doesn't seem to have sorted it!
This question has now been resolved thanks to LEBoyd! The solution is to .display the message and then immediately .close olDiscard. For some yet-to-be-explained reason, it fills the body. See LEBoyd's question here - Outlook 2010 Email body is empty
Try to remove any extra code (Access) from the NewMailEx event handler. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously. You should not assume that after these events fire, you will always get a one-item increase in the number of items in the Inbox.
The EntryIDsCollection string contains the Entry ID that corresponds to that item. Note that this behavior has changed from earlier versions of the event when the EntryIDCollection contained a list of comma-delimited Entry IDs of all the items received in the Inbox since the last time the event was fired.
Related
What I'd need guidance specifically:
To have an indication of a native VBA method available on a new mail compose that would be triggered at any written word / phrase (or as often as possible), or a guidance on how to create an observable of a dynamic form property.
Purpose:
One Outlook functionality that could be interesting to have is to know its readability values as the mail is composed. I know they can be obtained by doing the spell checker, but I'd like to avoid the burden of doing the spellcheck to get the result - I'd like to see numbers going up and down as the mail is written.
Problem:
I kind of created the function I'd need but I failed to find a method that could trigger it at every word written. I'd assume it'd be something like WordEditor_Change, HTMLBody_Change or something alike. It'd be similar to the Worksheet_Change we have in Excel, where values can be obtained as the Excel sheet is edited.
I tried to set an observable of WordEditor.words.count but also failed miserably.
What I have so far:
WithEvents myMail As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
Set myMail = Item
End Sub
Sub checkStatistics()
Dim objInsp As Outlook.Inspector
Set objInsp = myMail.GetInspector
'Enum Outlook: https://msdn.microsoft.com/es-es/VBA/Outlook-VBA/articles/olobjectclass-enumeration-outlook
If objInsp.EditorType = olEditorWord Then ' outlook 2013
'Doc obj: https://msdn.microsoft.com/en-us/vba/word-vba/articles/document-object-word
Set objdoc = objInsp.WordEditor
Dim var As ClassHandlesEvent
Dim tst As classWithEvent
Set var = New ClassHandlesEvent
Set tst = New classWithEvent
var.EventVariable = tst
tst.value = objdoc.Words.Count
MsgBox objdoc.ReadabilityStatistics(9) & ": " & objdoc.ReadabilityStatistics(9).value & vbCrLf & "(Ideal values above 60)"
MsgBox objdoc.ReadabilityStatistics(8) & ": " & objdoc.ReadabilityStatistics(8).value & vbCrLf & "(Ideal values above 60)"
End If
Set objdoc = Nothing
Set objInsp = Nothing
End Sub
The below code that you execute
Set objdoc = objInsp.WordEditor
Gives you a WordDocument so now you have a WordVBA question instead of a OutlookVBA question. So you want an onchange event on changes to the document
I got lot of threads inside and outside of SO, which confirms that such a event doesn't exists
http://www.vbaexpress.com/forum/showthread.php?15718-Is-there-a-text-change-event-for-Word
Is there a way to trigger "track changes" through VBA in Excel?
Detecting when data is added to a document, eg. a character or white space
http://www.vbaexpress.com/forum/showthread.php?40690-MS-WORD-2k7-Table-content-change-event
So you will need to use what you have now, which is to check the content on email send
I have VBA code whose main functions are:
Load a form
Allow a user to choose a stock email response
Open a word document with the full response text
Create a reply using the text
Search the email and create a collection of strings containing corporate file numbers
Add the file numbers to an Excel list
Send the response
Now I want to save one copy of the sent item in a Windows folder, for each file number. I’ve been trying to wait until the item is sent and moved to Sent Items. The problem is that after calling the send method, the mailitem doesn’t send or move to Sent Items until after the code finishes so I end up in an infinite loop.
All the options I found involve using a class module and WithEvents. That would work if I wanted to copy every sent item to the folder. I can’t think of any criteria that would differentiate the emails created by this macro from normal emails. I could go into the Excel list of files, but that would bog everybody’s machine down on every send.
Is there a way to just have the email send find out when it has been sent and moved to sent items? My code to send, wait for it to go to sent items, and to save the emails is below. Note I have two global variables: cReply (Outlook.MailItem – the reply) and fNums (Collection – the file numbers).
I'm coding in Outlook 2016, but hope to move the module to Outlook 2010 at work.
Sub Send()
Dim badChar As String
badChar = "\/:*?™""® <>|.&##_+`©~;-+=^$!,'" & Chr(34)
Dim x As Integer
Dim fName As String
Dim inSentItems As Boolean
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim cSent As Outlook.MailItem
Dim sentMoment As Date
fName = cReply.Subject
For x = 1 To Len(badChar)
fName = Replace(fName, Mid(badChar, x, 1), "-")
Next x
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.GetDefaultFolder(olFolderSentMail)
inSentItems = True
x = olFldr.Items.Count
sentMoment = Now
cReply.Send
Do While olFldr.Items.Count <> x + 1
If Now - sentMoment > TimeValue("0:00:10") Then
inSentItems = False
Exit Do
End If
DoEvents
Loop
If inSentItems Then
Set cSent = olFldr.Items(olFldr.Items.Count)
For x = 1 To fNums.Count
cSent.SaveAs sentFldrPth & fNums.Item(x) & " - " & fName & ".msg", olMSG
Next x
'cSent.Delete
End If
Set olApp = Nothing
Set olNS = Nothing
Set olFldr = Nothing
End Sub
You could use SaveSentMessageFolder to save to another folder.
https://msdn.microsoft.com/en-us/library/office/ff868473.aspx
Monitor this other folder with ItemAdd code. You could move the mail to the Sent Items folder once done.
Thanks to the excellent assistance given on this site I found the code below - which works perfectly. I cannot (embarrassingly enough) figure out how to loop through the entire Inbox to move all emails (rather than selection as the code below does).
Any assistance most gratefully appreciated it.
John
Sub MoveWithRecDate()
' Moves selected emails with correct dates maintained
Dim objNS As Outlook.NameSpace
Dim Session As Redemption.RDOSession
Dim objRDOFolder As Redemption.RDOFolder
Dim objItem As Outlook.MailItem
Dim objRDOMail As Redemption.RDOMail
Set objNS = Application.GetNamespace("MAPI")
Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set inbox = Session.GetDefaultFolder(olFolderInbox)
Set objRDOFolder = inbox.Parent.Folders("Cabinet")
For Each objItem In Application.ActiveExplorer.Selection
Set objRDOMail = Session.GetMessageFromID(objItem.EntryID)
objRDOMail.Move objRDOFolder
Next
End Sub
I had not heard of Redemption before reading your question. It looks very interesting so thank you for the information; I will try it next time I need to write a new Outlook macro.
I assume from the lack of an answer to your question that few others use Redemption either.
The Redemption website implies that the structure of Redemption code will be almost identical to standard Outlook code. I can only recall once writing a macro which operated on user selected items but my recollection is that the code looked like yours. The code below is standard Outlook but I hope that is enough for you to create the equivalent Redemption code.
You macro has the comment ' Moves selected emails with correct dates maintained. This implies you think there is a method by which emails can be moved so that dates are not maintained. I do not know such a method.
The code below examines every item in the Inbox. I did not want to move everything out of my Inbox so I have skipped items that are not mail items and are not from a specific sender.
I hope this is enough to get you going.
Sub MoveWithRecDate()
Dim FolderDest As MAPIFolder
Dim ItemToBeMoved As Boolean
Dim ItemCrnt As Object
Dim FolderSrc As MAPIFolder
Set FolderSrc = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set FolderDest = FolderSrc.Parent.Folders("Cabinet")
For Each ItemCrnt In FolderSrc.Items
ItemToBeMoved = True ' Assume item to be moved until discover otherwise
With ItemCrnt
If .Class = olMail Then
If .SenderEmailAddress <> "noreply#which.co.uk" Then
' Mail item not from Which
ItemToBeMoved = False
End If
Else
' Not mail item so do not move
ItemToBeMoved = False
End If
If ItemToBeMoved Then
.Move FolderDest
End If
End With
Next
End Sub
I am following the code from this page: How to create a script for the Rules Wizard in Outlook
This is what I have:
Public Sub GetMails(Item As Outlook.MailItem)
MsgBox "Mail message arrived: " & Item.SenderEmailAddress
MsgBox "Mail message arrived: " & Item.Subject
MsgBox "Mail message arrived: " & Item.Body
End Sub
I set a rule to run this macro. Every time this script runs there is a dialog about how a program is trying to access my mails.
How can I get rid of this using VBA or is there any configuration option in Outlook so that this does not appear?
I have googled for this and found some sites giving code for C# and VB.net but none for VBA.
This was added to prevent malicious scripts from turning Outlook into a mass mailer or other bad things.
You can turn this off on your workstation, but if you want to distribute your application to other users, you can get rid of this only by creating your own Outlook Addin or use a 3rd-party tool like Redemption.
Try this
Tools-->Macro-->Security-->macro security-->No security
Tools-->Macro-->Security-->Programmatic Access
Then choose Never warn me about suspicious activity.
I found this somewhere and it works:
Sub SaveAttachment(myItem As Outlook.MailItem)
' Remove ay attachments for the email and save them in a
' local folder. If there are any erros on the saveing then
' attachments are left in place.
Dim myAttachments As Object
Dim myOrt As String
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim oMail As Outlook.MailItem
Dim fs As Object
' We need to get the mail item object from the application
' object to avoid warning messages
strID = myItem.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set oMail = olNS.GetItemFromID(strID)
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
I have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email.
It is working for me, except sometimes the rule fails and Outlook deactivates it.
Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day.
I would love to fix this once and for all.
This code showed me the different TypeNames that were in my Inbox:
Public Sub GetTypeNamesInbox()
Dim myOlItems As Outlook.Items
Set myOlItems = application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Dim msg As Object
For Each msg In myOlItems
Debug.Print TypeName(msg)
'emails are typename MailItem
'Meeting responses are typename MeetingItem
'Delivery receipts are typename ReportItem
Next msg
End Sub
HTH
I use the following VBA code snippet in other Office Applications, where the Outlook Library is directly referenced.
' Outlook Variables
Dim objOutlook As Outlook.Application: Set objOutlook = New Outlook.Application
Dim objNameSpace As Outlook.NameSpace: Set objNameSpace = objOutlook.GetNamespace("MAPI")
Dim objFolder As MAPIFolder: Set objFolder = objNameSpace.PickFolder()
Dim objMailItem As Outlook.MailItem
Dim iCounter As Integer: iCounter = objFolder.Items.Count
Dim i As Integer
For i = iCounter To 1 Step -1
If TypeOf objFolder.Items(i) Is MailItem Then
Set objMailItem = objFolder.Items(i)
With objMailItem
etc.
have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email. It is working for me, except sometimes the rule fails and Outlook deactivates it. Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day. I would love to fix this once and for all.
Here is the code stripped of the functionality, but giving you an idea of how it looks:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
' Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) = "MailItem" Then
MyMessageHandler Item
End If
End Sub
Public Sub MyMessageHandler(ByRef Item As MailItem)
Dim strSender As String
Dim strSubject As String
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
strSender = LCase(Item.SenderEmailAddress)
strSubject = Item.Subject
rem do stuff
rem do stuff
rem do stuff
End Sub
One error I get is "Type Mismatch" calling MyMessageHandler where VB complains that Item is not a MailItem. Okay, but TypeName(Item) returns "MailItem", so how come Item is not a MailItem?
Another one I get is where an email with an empty subject comes along. The line
strSubject = Item.Subject
gives me an error. I know Item.Subject should be blank, but why is that an error?
Thanks.
My memory is somewhat cloudy on this, but I believe that a MailItem is not a MailItem when it is something like a read receipt. (Unfortunately, the VBA code that demonstrated this was written at another job and isn't around now.)
I also had code written to process incoming messages, probably for the same reason you did (too many rules for Exchange, or rules too complex for the Rules Wizard), and seem to recall running into the same problem you have, that some items seemed to be from a different type even though I was catching them with something like what you wrote.
I'll see if I can produce a specific example if it will help.
There are many types of items that can be seen in the default Inbox.
In the called procedure, assign the incoming item to an Object type variable. Then use TypeOf or TypeName to determine if it is a MailItem. Only then should your code perform actions that apply to emails.
i.e.
Dim obj As Object
If TypeName(obj) = "MailItem" Then
' your code for mail items here
End If
Dim objInboxFolder As MAPIFolder
Dim oItem As MailItem
Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objInboxFolder.Items
If TypeName(Item) = "MailItem" Then
Set oItem = Item
next
why not use a simple error handler for the code? Seriously. You could write an error for each read of a property or object that seems to fail. Then have it Resume no matter what. No need for complex error handling. Think of a test that shows an empty subject. Since you don't know what value it will return, if any, and it seems to error on an empty or blank subject, you need to picture it as a simple test with a possible error. Run the test as an if statement (one in which you will get an error anyway), and have the program resume on error.
On Error Resume Next
If object.subject = Null 'produces an error when subject is null, otherwise allows a good read
strSubject = "" 'sets the subject grab string to a null or empty string as a string
Else
strSubject = object.subject 'Sets the subject grab string to the subject of the message\item
End If