Outlook VBA fails to save changes to MailItem on older items only - vba

I have a macro in Outlook VBA that is designed to set the category of the selected email and send a reply email to the sender when a user clicks a button on the "Ribbon".
The below code will properly set the category on any newer emails, but throws "Run-time error '440': Cannot save this item." when run on emails that have been sitting around for a while. I don't know what causes this, as it runs fine for a while and then no longer works.
I tried restarting Outlook, logging in and logging out, and restarting the computer, and none of these seem to trigger the change in behavior, so I believe it is somehow related to the duration that the email has been sitting. This is rather confusing, as I don't see why length of time sitting in the folder should affect the ability to save, but not the ability to access the properties of the MailItem.
A simplified version of the code (without the email-sending part, which works fine) is as follows:
Public Sub UpdateCategory
Dim objItem as Object
Set objItem = GetCurrentItem()
'Verify that selected item is an email and an engineering request
If TypeName(objItem) = "MailItem" And InStr(LCase(objItem.Subject), "engineering request") > 0 Then
objItem.Categories = "Test"
objItem.Save
End If
Set objItem = Nothing
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
Any thoughts or suggestions would be greatly appreciated!!

Is this is an Exchange mailbox, it is possible that Exchange modified the item on the server side, that change was downloaded to the OST file, but since Outlook Object Model is not aware of the change, when you try to save the (stale) item, you get a conflict error.

Related

Get Current Body via Active Explorer in Currently Sending Email

Been trying various approaches from either experimenting or googling but cant seem to figure this one out.
In this code, when the email is being sent from the explorer via a reply, it only grabs the body from below what is "being sent now" instead of a lof it. I assume there is an object I haven't been able to find intuitively that holds this but I cant seem to figure out.
Anyone know what I might be over looking?
Code used
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim msg As MailItem
Set msg = GetCurrentItem()
prompt = msg.Body
MsgBox prompt
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

Writeable active inline response in outlook

I have the following code from some blog that inserts HTML from the clipboard into an outlook email.
Sub PrependClipboardHTML()
Dim email As Outlook.MailItem
Dim cBoard As DataObject
Set email = Application.ActiveInspector.CurrentItem
Set cBoard = New DataObject
cBoard.GetFromClipboard
email.HTMLBody = cBoard.GetText + email.HTMLBody
Set cBoard = Nothing
Set email = Nothing
End Sub
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
I was looking around on the documentation and found Application.ActiveExplorer.ActiveInlineResponse here.
However the documentations says that it is read-only, and indeed it does not work. Is there way to get a writable version of the inline response?
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
That is because you have the following statement in the code:
Set email = Application.ActiveInspector.CurrentItem
However the documentations says that it is read-only, and indeed it does not work.
Try to use the following code instead:
Set email = Application.ActiveExplorer.ActiveInlineResponse
The ActiveInlineResponse property is read-only, but not the object's properties you are going to use. That means you can't set another mail item to the inline response, but will be able to set up properties of the retrieved item.
Maybe you're trying to work with ActiveExplorer + Selection.Item Method (Outlook)
Example
Option Explicit
Public Sub Example()
Dim email As Outlook.MailItem
Set email = Application.ActiveExplorer.Selection.Item(1)
Debug.Print email.Subject ' print on immediate window
End Sub
Or Work with both opened and selected items
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
You cannot concatenate two HTML strings and expect a valid HTML back. The two must be merged.
That being said, use Word Object Model to paste from the clipboard:
Application.ActiveEXplorer.ActiveInlineResponseWordEditor.Application.Selection.Paste()

Whenever a mail is sent from Outlook 2010 that mail should move to dedicated folder in Outlook, using VBA/Macros

I have already wrote a code where the when ever a email comes from a definite email ID to outlook my ID it gets sent to anothee email address automatically by using one rule.
Now I have to add one feature. This mail which is sent is also saved in a dedicated folder other than sent items. All this in one script.
This my current script where only the mail goes automatically. Now I need help to add the dedicated folder feature.
Sub Project_1()
Dim objMail As Outlook.MailItem
Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
objMail.To = "inbox#email.com"
objMail.Display
objMail.Send
Set objItem = Nothing
Set objMail = Nothing
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
Case Else
End Select
End Function
I am very new to VBA.
As #destination-data stated above, the whole task will be much easier through outlooks rules.
This article is a step-by-step guide on how to set rules for moving certain mails based on conditions. Additionally you can easily add a "forward" rule, since all your desired functionality is already implemented into outlook and one should avoid rewriting existing tools.
According to your description, this should accomplish the exact same thing as intended by your code.

Call Outlook procedure using VBScript

I have a procedure in Outlook that sends all the saved messages in Drafts folder.
Below is the code:
Public Sub SendMail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olDraft As Outlook.MAPIFolder
Dim strfoldername As String
Dim i As Integer
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
End Sub
Above code works fine.
Question:
I want to use Task Scheduler to fire this procedure as a specified time.
1. Where will I put the procedure in Outlook, Module or ThisOutlookSession?
2. I am not good in vbscript so I also don't know how to code it to call the Outlook Procedure. I've done calling Excel Procedure but Outlook doesn't support .Run property.
So this doesn't work:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Run "ProcedureName"
Set olApp = Nothing
I've also read about the Session.Logon like this:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Session.Logon
olApp.ProcedureName
Set olApp = Nothing
But it throws up error saying object ProcedureName is not supported.
Hope somebody can shed some light.
SOLUTION:
Ok, I've figured out 2 work around to Avoid or get pass this pop-up.
1st one: is as KazJaw Pointed out.
Assuming you have another program (eg. Excel, VBScript) which includes sending of mail via Outlook in the procedure.
Instead of using .Send, just .Save the mail.
It will be saved in the Outlook's Draft folder.
Then using below code, send the draft which fires using Outlook Task Reminder.
Option Explicit
Private WithEvents my_reminder As Outlook.Reminders
Private Sub Application_Reminder(ByVal Item As Object)
Dim myitem As TaskItem
If Item.Class = olTask Then 'This works the same as the next line but i prefer it since it automatically provides you the different item classes.
'If TypeName(Item) = "TaskItem" Then
Set my_reminder = Outlook.Reminders
Set myitem = Item
If myitem.Subject = "Send Draft" Then
Call SendMail
End If
End If
End Sub
Private Sub my_reminder_BeforeReminderShow(Cancel As Boolean)
Cancel = True
Set my_reminder = Nothing
End Sub
Above code fires when Task Reminder shows with a subject "Send Draft".
But, we don't want it showing since the whole point is just to call the SendMail procedure.
So we added a procedure that Cancels the display of reminder which is of olTask class or TaskItem Type.
This requires that Outlook is running of course.
You can keep it running 24 hours as i did or, create a VBscript that opens it to be scheduled via Task Scheduler.
2nd one: is to use API to programatically click on Allow button when the security pop-up appears.
Credits to SiddarthRout for the help.
Here is the LINK which will help you programmatically click on the Allow button.
Of course you have to tweak it a bit.
Tried & Tested!
Assuming that you have Outlook Application always running (according to comment below your question) you can do what you need in the following steps:
add a new task in Outlook, set subject to: "run macro YourMacroName" and set time (plus cycles) when your macro should start.
go to VBA Editor, open ThisOutlookSession module and add the following code inside (plus see the comments inside the code):
Private Sub Application_Reminder(ByVal Item As Object)
If TypeName(Item) = "TaskItem" Then
Dim myItem As TaskItem
Set myItem = Item
If myItem.Subject = "run macro YourMacroName" Then
Call YourMacroName '...your macro name here
End If
End If
End Sub
Where will I put the procedure in Outlook, Module or ThisOutlookSession?
Neither. Paste the below code in a Text File and save it as a .VBS file. Then call this VBS file from the Task Scheduler as shown HERE
Dim olApp, olNS, olFolder, olDraft, strfoldername, i
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(6)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
If you are using Outlook 2007 or newer I have found you can easily eliminate the security pop up you mentioned above when running your script by doing the following:
In Outlook 2007 Trust Center, go to Macro Security - Select "No security Check for macros"
In Outlook 2007 Trust Center, go to Programatic Access - Select "Never warn me abous suspicious activity.
Of course that technically leaves you open to the remote possibility for someone to email you some malicious email script or something of that nature I assume. I trust my company has that managed though and this works for me. I can use VBS scripts in Outlook, Access, Excel to send emails with no security pop up.
Another Option:
If you don't want to do that, another option that has worked well for me prior to this is here:
http://www.dimastr.com/redemption/objects.htm
Basically a dll redirect that does not include the popup. It leaves your other default security in place and you write \ call your VBA for it and send mail without the secutity pop-ups.

Sending email through MS Access VBA / Outlook, choosing sending profile

I am looking at this snippet of code from another question here (MS Access VBA): https://stackoverflow.com/a/17975507/1085885
Right now this code only works when I run it while Outlook is open. Is there any way for this code to "open Outlook" and then run all the sending code?
Secondly, how can I choose which Outlook profile to send from? I have access to a couple different profiles and it's sending from my main top inbox but I want it to come from my second inbox.
You need to log to the specified profile (as shown in "Control Panel | Mail | Show Profiles", if that is what you mean by "profile"). After creating an instance of the Outlook application
Set oApp = CreateObject("Outlook.application")
add something like the following:
set oNS = oApp.GetNamespace.Logon
oNS.Logon("MyProfileName")
Note if Outlook is already running, Logon will do nothing. You will need to use Extended MAPI (C++ or Delphi or a MAPI wrapper like Redemption (I am its author, use RDOSession.Logon) to log to a specified profile.
If by "profile" you actually mean a different account in the same profile in Outlook, you can set the MailItem.SendUsingAccount property to specify a particular account.
If you are sending from an Exchange mailbox, and you need to set a different sender, set the MailItem.SentOnBehalfOfName property to the name of the user on whose behalf you are sending (assuming you have the right to send on behalf of that user).
Try it this way.
Private Sub Command1_Click()
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
'Set the recipient for the new email
.To = "receiver#gmail.com"
.Send
End With
If bStarted Then
' 'If we started Outlook from code, then close it
oOutlookApp.Quit
End If
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub