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

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.

Related

Outlook does not recognize one or more names

I have following vba code which reads a mailbox and sends reply to any users who send a invalid code as a reply to the mailbox, but sometimes the run time error (Outlook does not recognize one or more names) is received. My questions are,
Will creation of new MAPI profile resolve the issue or do i need to add a code that resolves the address and ignores if the email id no longer exist. if yes how do i do that?
Also in general whats the parameter to not send emails for specific condition?
Below is the code that we currently have:
Sub ResponseCodeError(Item As Outlook.MailItem)
'If not a valid code then send email to the User
If (Left(Item.Subject, 2) <> "S;" And Left(Item.Subject, 2) <> "N;") Then
Dim outobj, mailobj
Set outobj = CreateObject("Outlook.Application")
Set mailobj = outobj.CreateItem(0)
With mailobj
.To = Item.SenderEmailAddress
.Subject = "Invalid Code"
.Body = "Please use a valid CODE"
.Send
End With
'Move Email to Error Folder
mailboxNameString = "mailboxname"
FolderName = "Error"
Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olCurrExplorer As Outlook.Explorer
Dim olCurrSelection As Outlook.Selection
Dim olDestFolder As Outlook.MAPIFolder
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olCurrExplorer = olApp.ActiveExplorer
Set olCurrSelection = olCurrExplorer.Selection
Set olDestFolder = olNameSpace.Folders(mailboxNameString).Folders(FolderName)
Item.Move olDestFolder
End If
Set outobj = Nothing
Set mailobj = Nothing
End Sub
I had once the same error, and I resolved it after 5 hours searching like crazy in the code. But it was much simpler: 1 email address had an error missing the .(dot) in the domain name.
Instead of setting the To property, call MailItem.Recipients.Add (returns Recipient object). Call Recipient.Resolve - it will return false if the name cannot be resolved.
The issue might be due to incorrect names, extra characters or spaces in some property of Item.(especially To, BCC, CC or collective property Recipients)
It might also be due to names not resolved yet before sending the mail. I am not sure but would assume that the error was due to trying to resolve names while sending the mail and probably being unable to resolve them due to some issue. Explicitly resolving names like the code below before the mail is sent should solve the issue.
Item.Recipient.ResolveAll can be used to resolve the names before sending the mail. It returns true if all names were successfully resolved.
Code: (Reference)
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox myRecipient.Name
End If
Next
End If
I have tested the code without adding and resolving recipients 1 by 1.(suggested by Dmitry)
I used Item.To, Item.BCC properties. Then used ResolveAll and send the mail only if all names are resolved.
I just ran into this error; code that had been working for years suddenly triggered the "Outlook does not recognize one or more names" error.
I discovered that the recipient was an Outlook shared folder name, ie. "My Shared Folder" and whether it is an Access 2016 or Outlook issue, the name could no longer resolve to its associated email address. Changing the recipient to "mysharedfolder#blahblah.com" resolved the issue for me.
SOLVED In my case in Outlook I had several contacts with the same e-mail (two companies that are run by one contact/e-mail) and that created the problem. I deleted one of the contacts so no e-mail is repeated in the contact list in Outlook and now it works. Note that my batch still sends an e-mail twice to that contact which info for each company which is what I wanted it.

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.

Move Outlook messages if content contains a number greater than threshold

I get thousands of Nagios alerts in my inbox daily, but many of them are actually trivial (even though Nagios reports them as critical). I want to check whether the text of these alerts contains numbers above a certain threshold; if the numbers are lower than that threshold, move the message to a junk folder. I should really work with my sysadmin to decrease the number of useless alerts Nagios sends in the first place, but humor me in my attempt at a creative workaround.
I'm using Outlook 2007 and have found several tutorials on writing Outlook macros in VB, including this one about programmatically creating a rule to move messages to different folders. That example uses a TextRuleCondition to check whether the subject contains any of the keywords in an array.
But I don't want to check for keywords, I want to check if a number in the message text is greater or less than a threshold value. For example, if the text of a message contains the following, it could be moved to a junk folder:
Nagios bad condition: foo = 3
But if a message contained this, I would want to keep it:
Nagios bad condition: foo = 157
This example seems a little more like what I want in terms of searching the content of the message for arbitrary text. But it requires the message to be open, so I'm not quite sure how to translate it into a rule. Any help would be appreciated.
The second example you link to will put you on the right track to write code that discriminates between good and junk e-mails.
Then you will want to put that code in the _ItemAdd event for the Inbox items, such that it runs every time something new pops up in your Inbox. Here's an example of what should go in your Outlook VBA module:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Upon starting Outlook, set reference to the items in the Inbox.
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' Because myOlItems is declared "WithEvents",
' the ItemAdd event will fire anytime something new pops up in the Inbox.
If TypeName(Item) = "MailItem" Then
' It's an e-mail.
' Here goes the code to test whether it should go to the junk folder.
Else
' It's something else than an e-mail.
' Do nothing.
End If
End Sub
JFC has already given you one way. Here is another using RULES to check messages as they arrive. Do this.
Open VBA Editor and paste this code in ThisOutlookSession
UNTESTED
Option Explicit
Sub Sample(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim objInboxFolder As Outlook.MAPIFolder
Dim objDestinationFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim strFileName As String, strSubj As String
Dim Myarray() As String
Dim ThrsdVal As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Email Subject
strSubj = olMail.Subject
'~~> Threshold value
ThrsdVal = 100
'Nagios bad condition: foo = 3
Myarray = Split(strSubj, "=")
Set objInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
'~~> Destination folder
Set objDestinationFolder = objInboxFolder.Folders("Temp")
'~~> Check if less than threshold value
If Val(Trim(Myarray(1))) < ThrsdVal Then
olMail.Move objDestinationFolder
End If
Set olMail = Nothing
Set olNS = Nothing
End Sub
Now
1) Create a new Rule (Select "Check Messages When they Arrive")
2) In (Condition) select "From people or Distribution List"
3) Select the relevant email address from which you are getting the emails
4) In Actions, select "run a script" and then choose the above script.
5) Finally click on Finish and you are done :)
The best part about this is that you can run this rule for existing emails in your inbox folder as well :)
NOTE: Like I mentioned above, I have not tested the code so do let me know if you get any errors and I will rectify it. Also I am assuming that the message will have a subject with the format as "Nagios bad condition: foo = X". I have not included any error handling. I am sure you can take care of that :)
HTH
Sid

VB.net 2005 Sending Emails With Outlook 2003

We currently use the following code to create an email in Outlook so that the user can type what they want in Outlook, then when the email is sent, the system prompts them to see if they would like to save the email.
Dim objOutlook As Object
Dim objMessage As Object
Dim objInspector As Object
If strEMail <> "" Then
objOutlook = CreateObject("Outlook.Application")
objMessage = objOutlook.CreateItem(0)
objMessage.To = strEMail
objInspector = objMessage.GetInspector
objInspector.Display()
While Not objInspector.CurrentItem Is Nothing
End While
frmSaveSentEmail.BringToFront()
frmSaveSentEmail.ShowDialog()
The code works fine on Outlook 2003 as long as they are not using Word as their email editor. However, with Word set up as the email editor, the while loop that tests to see if the email object is closed never ends.
Is there a way to handle this differently so that it will work even with Word as the editor?
I am not terribly experienced with programming Outlook via VB.NET, but that loop certainly looks suspicious. Perhaps you should try taking advantage of the inspector's Close event instead of repeatedly checking its CurrentItem property. If I am not mistaken, you should be able to present your dialog within the event handler.
Ended up changing the loop to:
While Not objOutlook.ActiveInspector Is Nothing
End While
This resolved the issue.

Outlook VBA - Get Details Of Current Active (Or Open) Email

I am completely stuck as to how to retrieve details of an email which is either currently selected or open. In fact, I can't find any details on how to access an email. It seems you can traverse the entire folder structure and get all emails, but that doesn't really help me.
I don't suppose I can get some pointers?
And yes, I hate VBA as much as the next developer, but unfortunately about 0.1% of my work involves integration with Outlook.
Cheers.
To get the currently selected emails by looking at the Selection object of the Explorer.
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
The selection object can contain many items and also contain Items that are of other types than mail (IPM.Note) i.e calendar apps etc. So if you only want mail items you can take a look at the item MessageClass
As for the current email that is trickier as you can multuiple of these open if you just want the top most you can use the Application.ActiveInspector otherwise you should look at the Inspectors Collection of the Application object. You can then get the "item" from the CurrentItem property off the Inspector(remember these can be non mails as well)
Hope full that will get you going
I ended up here as I was looking for a way to use VBA to modify the email that is currently being composed. While the ActiveInspector solution above works if the new email is in a new window, it does not work if replying 'inline' (in the preview pane). For this, I wrote this function:
Private Function CurrentEmail() As MailItem
Dim thisMail As MailItem
If Application.ActiveInspector Is Nothing Then
'editing in preview pane
Set thisMail = Application.ActiveExplorer.ActiveInlineResponse
Else
'editing in pop out window
Set thisMail = Application.ActiveInspector.CurrentItem
End If
If thisMail Is Nothing Then Exit Function
If thisMail.Sent Then Exit Function 'ignore sent items
Set CurrentEmail = thisMail
End Function