Stop multiple PCs running same script for generic mailbox - vba

I made a script to auto forward messages (with custom response) and, from what i gathered, it has to be on a running Outlook for it to be working.
The issue is that if a couple of machines are running that script will it "go off" multiple times?
from specific sender
containing XYZ in subject
except when it contains ABC in subject
Public Sub FW(olItem As Outlook.MailItem)
Dim olForward As Outlook.MailItem
Set olForward = olItem.Forward
With olForward
'Stuff happens here that work properly
End With
End If
'// Clean up
Set olItem = Nothing
Set olForward = Nothing
End Sub

As #Barney comment is absolutely correct and multiple runs of the script will trigger multiple forward of the item, I would like to add what you should do to perform your action once.
In the script right after successful forward of the message you should add a custom property into the item. The property will just indicate that the message was already forwarded (may be parsed/touched by your script). Now make the condition for entire item handling and check this property exists. If it does, do not perform any actions. The following resource will help with custom properties: How To: Add a custom property to the UserProperties collection of an Outlook e-mail item

Related

Outlook 2003: Connect IMAP server with VBA

Sometimes Outlook (2003) loses the connection to one or more IMAP server. With VBA scripts that are supposed to move mails to these mailboxes, for example, I get this error message:
"Runtime error '-972759285 (c604df0b)':
Connection to server is unavailable. Outlook must be online or connected to complete this operation."
I then first have to click on "File" - "Connect to [MAILBOX...]" to establish this connection manually.
I am looking for a VBA solution to automatically connect to multiple mailboxes (IMAP only), but I don't know what to look for in VBA references.
I tried this:
Sub MyTest()
Dim myNameSpace As Outlook.NameSpace
Set myNameSpace = Application.GetNamespace("MAPI")
Set Application.ActiveExplorer.CurrentFolder = myNameSpace.Folders("C-Interessenten").Folders("Interessenten")
Set myNameSpace = Nothing
End Sub
or this
Sub IsOLOffline()
'Determines whether Outlook is currently offline.
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Set myOlApp = New Outlook.Application
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Debug.Print myNameSpace.Offline
End Sub
Thank you for an idea.
The Outlook object model doesn't provide anything for that out of the box.
The Offline property of the Namespace class returns valid information only for an Exchange profile. It's not intended for non-Exchange account types such as POP3, IMAPI, and HTTP.
You may try to use SyncObjects property of the Namespace class. It returns a set of SyncObject objects representing the Send/Receive groups for a user.
The OnError event is fired when Microsoft Outlook encounters an error while synchronizing a user's folders using the specified Send\Receive group. So, it could help with detecting such cases and then initiating a new sync.
Public WithEvents mySync As Outlook.SyncObject
Sub Initialize_handler()
Set mySync = Application.Session.SyncObjects.Item(1)
mySync.Start
mySync.Stop
End Sub
Private Sub mySync_OnError(ByVal Code As Long, ByVal Description As String)
MsgBox "Unexpected sync error" & Code & ": " & Description
End Sub
A Send\Receive group lets users configure different synchronization scenarios, selecting which folders and which filters apply.
Use the Item method to retrieve the SyncObject object from a SyncObjects object. Because the Name property is the default property of the SyncObject object, you can identify the group by name.
Thank you for the food for thought. I have already experimented a bit by creating a separate group for each IMAP mailbox. Testing is taking a long time because the connections only break sporadically and I can't trigger the break manually. Nevertheless, I have more and more the impression that the SyncObject does not lead to a solution. Thanks anyway.
Is there perhaps the possibility to call the menu item "File" - "Connect to xxx" via vba, for example via FindControl()?

Run a script is running on old mail before new email moved to the target folder

I created a rule to move a daily email to a specific folder and run a VBA script to save the table from this email's body.
When the email is received, VBA starts running and grabbing previous email with the same subject and only after does the new email appear in my target folder.
I tried sleep.
Is there any way to first move new email to a target folder then run a script?
Sub ExportOutlookTableToExcel()`
Dim oLookInspector As Inspector
Dim oLookMailitem As MailItem
Dim oLookWordDoc As Word.Document
Dim oLookWordTbl As Word.Table
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
'Grab Email Item
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
Set oLookInspector = oLookMailitem.GetInspector
Set oLookWordDoc = oLookInspector.WordEditor
Re: I created a rule to move this email to a specific folder and run a VBA script
You are not the first to fall into this trap. Put the move as the last action in the code.
Consider not using "run a script" code in rules. There is ItemAdd for any folder or NewMailEx for the Inbox.
Re: Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
The most recent mail with subject "Apples Sales" can be found like this:
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub mostRecentlyReceivedMail_Subject_DemoOnly()
Dim oLookFolder As Folder
Dim oLookFolderItems As Items
Dim srchSubject As String
Dim i As Long
Dim oLookMailitem As MailItem
Set oLookFolder = ActiveExplorer.CurrentFolder
Set oLookFolderItems = oLookFolder.Items
' sort the collection not the folder
oLookFolderItems.Sort "[ReceivedTime]", True
srchSubject = "Apples Sales"
' This is demonstration code only.
' Without introducing methods to reduce the number of items to look through
' it shows the use of an index rather than subject.
' In this case the required item is supposed to be first in the collection.
For i = 1 To oLookFolderItems.Count
' first verify object in folder is a mailitem
If oLookFolderItems(i).Class = olMail Then
' Index not subject
Set oLookMailitem = oLookFolderItems(i)
If oLookMailitem.subject = srchSubject Then
Debug.Print oLookMailitem.ReceivedTime
oLookMailitem.Display
Exit For
End If
End If
Next
End Sub
Although subject is valid in
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
it probably has little to no practical use.
I creted a rule to move this email to a specific folder and run a vba script to save the table from this new emails body.
There is no need to create a rule and run a VBA script. Instead, to handle incoming emails immediately you need to handle the NewMailEx event which is fired when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. 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. Also you may consider handling the ItemAdd event on the folder where your items are moved. But it has a known disadvantage - the event is not fired if more than sixteen items are moved at the same time. This is a known issue when dealing with OOM.
In the NewMailEx event handler you may get an instance of the incoming email and move it to the required folder programmatically where you could run any other actions.

Activate Out of Office reply

I would like to automate my Out of Office based on the days that I'll be out on a biweekly basis. I don't have access to the Exchange server that hosts our Outlook.
I set an Outlook rule to send a automatic reply on Monday and apply VBA code to disable this rule when I'm in the office (with Outlook open). This is not an elegant way because the rule sends a reply to the user repeatedly every time an email is sent to me.
How can I activate my Out of Office reply on Outlook 2010 using VBA?
Here are the two resources I used:
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_outlook-mso_win10/set-up-recurring-out-of-office-auto-reply-for/71dd1fef-ba99-4a2b-be72-7d509e8848eb
https://superuser.com/questions/292426/outlook-2010-how-to-turn-out-of-office-on-automatically-when-outlook-is-closed
This is the script I have in "ThisOutlookSession" to enable/disable the rule, "HomeTime" containing my Out Of Office-like message.
Option Explicit
Private Sub Application_Quit()
SetRuleEnabled True
End Sub
Private Sub Application_Startup()
SetRuleEnabled False
End Sub
Private Sub SetRuleEnabled(ByVal bEnable As Boolean)
Dim oSession As Outlook.NameSpace
Dim oRule As Outlook.Rule
Dim oRules As Outlook.Rules
Dim oPA As Outlook.PropertyAccessor
Set oSession = Application.Session
Set oRules = oSession.DefaultStore.GetRules()
Set oPA = oSession.DefaultStore.PropertyAccessor
'*** If the Out-Of-Office is already on (eg. holidays, sick leave etc.)
'*** then it might be best to force this rule permanently off
If oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B") Then
bEnable = False
End If
For Each oRule In oRules
If oRule.Name = "HomeTime" Then
oRule.Enabled = bEnable
oRules.Save
Exit For
End If
Next
End Sub
I am assuming you've checked out Om3r's link, but I have a less elegant, if not clunky solution. I once created a VBA out of office message as a practical joke (just to avoid someone). I could not find the code, but here is a summary of what you'd need to do.
(Outlook has to be running for this to work)
Create a public boolean variable, for example OutofOffice, set by a ribbon/QAT button or on a schedule.
Create and save a draft email with your message (e.g. "I am out of the office...")
Use or set up an Inbox_ItemAdd event listener, and for each incoming email:
Reply to it,
concatenating "Auto-Reply " to the subject line
Retrieve the draft email and concatenate your draft message body to the reply body (and you'll have to figure out HTMLBody versus (non-HTML) Body. Something like:
OutMail.HTMLBody = OutMail.HTMLBody & ObjDraft.HTMLBody
or you might save your OOO message as a public static string (instead of a draft email).
Send the email
as you mentioned, you don't want to repeatedly send this to people who sent you additional emails during this period. I would probably add the sender's email address (after passing to a GetSMTPAddress type function) to an array. I'd add a IsInArray type function to check each new sender (to see if they were emailed already). This array would be erased by your procedure called when you click that control again to turn off the OOO reply.
If this worked for you, of course you could create a userform to edit the OOO message and set the schedule (day of week or specific dates).

Outlook code is working when manually called but giving trouble from Application_ItemSend

I have a code that checks the recipient of the mail, looks what organization is set in the address book for the recipient and dependent on that sets the "SentOnBehalfOfName"-property of the item. If the recipient is working for client2, he will get the mail from "we_love_to_serve_client2#domain.com".
I call the code either before sending the mail via a button in my ribbon, that calls this Sub:
Sub Signatur()
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
Set objMail = Application.ActiveInspector.CurrentItem
Call Signatur_auto(objMail)
End Sub
I do this if I want to know which mail-adress is going to be chosen.
In the itemSend-section of thisOutlookSession I also call the same sub
Call Signatur_auto(Item)
Part of the Signatur_auto (i do not copy that in, the question is too long already...) is dealing with the SentOnBehalfOfName-property, the other part is putting the item into the right folder. The Folder is chosen depending on the SentOnBehalfOfName-property.
Now comes the interesting part: Although the folder-part is always working (which can only be when the SentOnBehalfOfName has worked before), the SentOnBehalfOfName only works "half". In the preview-line the mail sent is shown as from "we_serve_client2#domain.com", but when I open the mail it says it was sent by me. The Client always only sees my address, and also answers to my address - which I do not want....
How cant be, that the same code is having different results dependent on where it is called? Is it a Problem to change the sendonbehalf-field in the item send-section?
Thanks for any Inputs!
Max
Why it does not work?
Try this in ItemSend.
Dim copiedItem As mailItem
Set copiedItem = Item.Copy
copiedItem.SentOnBehalfOfName = "we_love_to_serve_client2#domain.com"
copiedItem.Send
Item.delete
Cancel = True ' In case your setup generates an error message as described in the comments
Why it works? Appears "copiedItem.Send" bypasses ItemSend.

How do I make Outlook purge a folder automatically when anything arrives in it?

I hope it's okay to ask this kind of question. Attempting to write the code myself is completely beyond me at the moment.
I need a macro for Outlook 2007 that will permanently delete all content of the Sent Items folder whenever anything arrives in it. Is it possible? How do I set everything up so that the user doesn't ever have to click anything to run it?
I know I'm asking for a fish, and I'm embarrassed, but I really need the thing...
edit:
I've pasted this into the VBA editor, into a new module:
Public Sub EmptySentEmailFolder()
Dim outApp As Outlook.Application
Dim sentFolder As Outlook.MAPIFolder
Dim item As Object
Dim entryID As String
Set outApp = CreateObject("outlook.application")
Set sentFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete '' Delete from mail folder
Next
Set item = Nothing
Set sentFolder = Nothing
Set outApp = Nothing
End Sub
It's just a slightly modified version of a piece of code I found somewhere on this site deleting Deleted Items. It does delete the Sent Items folder when I run it. Could you please help me modify it in such a way that it deletes Sent Items whenever anything appears in the folder, and in such a way that the user doesn't have to click anything to run it? I need it to be a completely automated process.
edit 2: Please if you think there's a better tool to achieve this than VBA, don't hesitate to edit the tags and comment.
edit 3: I did something that works sometimes, but sometimes it doesn't. And it's ridiculously complicated. I set a rule that ccs every sent email with an attachment to me. Another rule runs the following code, when an email from me arrives.
Sub Del(item As Outlook.MailItem)
Call EmptySentEmailFolder
End Sub
The thing has three behaviors, and I haven't been able to determine what triggers which behavior. Sometimes the thing does purge the Sent Items folder. Sometimes it does nothing. Sometimes the second rule gives the "operation failed" error message.
The idea of acting whenever something comes from my address is non-optimal for reasons that I'll omit for the sake of brevity. I tried to replace it with reports. I made a rule that sends a delivery report whenever I send an email. Then another rule runs the code upon receipt of the report. However, this has just one behavior: it never does anything.
Both ideas are so complicated that anything could go wrong really, and I'm having trouble debugging them. Both are non-optimal solutions too.
Would this be an acceptable solution? Sorry its late but my copy of Outlook was broken.
When you enter the Outlook VB Editor, the Project Explorer will be on the left. Click Ctrl+R if it isn't. It will look something like this:
+ Project1 (VbaProject.OTM)
or
- Project1 (VbaProject.OTM)
+ Microsoft Office Outlook Objects
+ Forms
+ Modules
"Forms" will be missing if you do not have any user forms. It is possible "Modules" is expanded. Click +s as necessary to get "Microsoft Office Outlook Objects" expanded:
- Project1 (VbaProject.OTM)
- Microsoft Office Outlook Objects
ThisOutlookSession
+ Forms
+ Modules
Click ThisOutlookSession. The module area will turn white unless you have already used this code area. This area is like a module but have additional privileges. Copy this code to that area:
Private Sub Application_MAPILogonComplete()
' This event routine is called automatically when a user has completed log in.
Dim sentFolder As Outlook.MAPIFolder
Dim entryID As String
Dim i As Long
Set sentFolder = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete ' Move to Deleted Items
Next
Set sentFolder = Nothing
End Sub
I have taken your code, tidied it up a little and placed it within an event routine. An event routine is automatically called when the appropriate event occurs. This routine is called when the user has completed their log in. This is not what you requested but it might be an acceptable compromise.
Suggestion 2
I have not tried an ItemAdd event routine on the Sent Items folder before although I have used it with the Inbox. According to my limited testing, deleting the sent item does not interfere with the sending.
This code belongs in "ThisOutlookSession".
Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_MAPILogonComplete()
Dim NS As NameSpace
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
With NS
Set MyNewItems = NS.GetDefaultFolder(olFolderSentMail).Items
End With
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
Debug.Print "--------------------"
Debug.Print "Item added to Sent folder"
Debug.Print "Subject: " & Item.Subject
Item.Delete ' Move to Deleted Items
Debug.Print "Moved to Deleted Items"
End Sub
The Debug.Print statements show you have limited access to the sent item. If you try to access more sensitive properties, you will trigger a warning to the user that a macro is assessing emails.