This code is executed every time I select a message. I want this code to be executed only when I am composing new mail/replying/forwarding.
Private Sub Application_ItemLoad(ByVal Item As Object)
Dim oAccount As Outlook.Explorer
If TypeName(Item) = "MailItem" Then
MsgBox ("this is mail")
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.FolderPath)
End If
End Sub
What I am trying to achieve: When composing mail from specific account (account#mail.com) add recipient in CC field.
I am a noob in programming.
You can test the MailItem.Sent property to determine whether composing mail or reading received mail.
Private Sub Application_ItemLoad(ByVal Item As Object)
Dim oAccount As Outlook.Explorer
If TypeName(Item) = "MailItem" Then
If item.Sent Then
MsgBox "Not for processing"
Else
MsgBox "Processing this mail"
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.FolderPath)
End If
End If
End Sub
Related
My code looks like this:
Public WithEvents myItem As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If Item.Class = olMail Then
Set myItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
Dim oAccount As Outlook.Explorer
Dim oMail As MailItem
Dim Recip As Outlook.Recipient
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.Store)
If oAccount.CurrentFolder.Store = "1#2.com" Then
MsgBox ("CC needs to be added")
Set Recip = myItem.Recipients.Add("user#test.com")
Recip.Type = olBCC
Else
MsgBox ("no need to add CC")
End If
End Sub
The part responsible for adding user#test.com to the CC field is adding that address to the "To:" field instead.
i just had to add Recip.Resolve after Recip.Type = olCC. That solved the issue.
My users have their personal mailbox as their primary account and an auto-mapped shared mailbox configured in their Outlook 2010 client. The shared mailbox is an Office 365 shared mailbox and thus cannot be logged into to set it as the primary account.
I am trying to start a new email from the shared account's address.
Below is the VBA code I have been trying to use. I have allowed Macros in Outlook's trust center settings.
Public Sub New_Mail()
Dim oAccount As Outlook.Account
Dim oMail As Outlook.MailItem
For Each oAccount In Application.Session.Accounts
If oAccount = "sharedMailboxAddress#domain.tld" Then
Set oMail = Application.CreateItem(olMailItem)
oMail.SendUsingAccount = oAccount
oMail.Display
End If
Next
End Sub
Using the following code with the SentOnBehalfOfName property starts a new email from the shared mailbox's address. Thanks to Dmitry Streblechenko for pointing me in the right direction.
Sub New_Mail()
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.SentOnBehalfOfName = "sharedMailboxAddress#domain.tld"
.Display
End With
Set objMsg = Nothing
End Sub
A delegate mailbox will not be in the Namespace.Accounts list.
Set the MailItem.SentOnBehalfOfName property instead.
What does not work in your code?
Use the smtpAddress property to select an account.
Example function:
Private Function GetAccountForEmailAddress(smtpAddress As String) As Outlook.account
Dim account As Outlook.account
For Each account In Application.Session.accounts
If LCase(account.smtpAddress) = LCase(smtpAddress) Then
Set GetAccountForEmailAddress = account
Exit Function
End If
Next account
MsgBox "No Account with SmtpAddress: " & smtpAddress & " exists!", vbCritical, "Oops!"
Set GetAccountForEmailAddress = Nothing
End Function
The debug.print line will show you the accounts.
Option Explicit
Public Sub New_Mail()
Dim oAccount As account
Dim oMail As mailItem
For Each oAccount In Session.Accounts
Debug.Print oAccount
If LCase(oAccount) = LCase("text copied from the immediate window") Then
Set oMail = CreateItem(olMailItem)
oMail.SendUsingAccount = oAccount
oMail.Display
End If
Next
ExitRoutine:
Set oMail = Nothing
End Sub
Not exactly the problem I had, but this question and the answers helped. My problem was to send from a particular mailbox while using many accounts. The one-liner answer was this:
OutMail.SendUsingAccount = OutApp.Session.Accounts.Item("address#domain.com")
I changed the sender data in the currently open mail.
This is well done by the following code:
Sub AktiveMailSetVonHotline()
Dim oMail As Outlook.MailItem
Set oMail = ActiveInspector.CurrentItem
oMail.SentOnBehalfOfName = "Hotline#mycompany.de"
End Sub`
I cannot see that the sender is set as desired. For this, I'd like to refresh the visible Mail (inspector window).
It looks like you are interested in the SendUsingAccount property of the MailItem class which allows to set an Account object that represents the account under which the MailItem is to be sent. For example:
Sub SendUsingAccount()
Dim oAccount As Outlook.account
For Each oAccount In Application.Session.Accounts
If oAccount.AccountType = olPop3 Then
Dim oMail As Outlook.MailItem
Set oMail = Application.CreateItem(olMailItem)
oMail.Subject = "Sent using POP3 Account"
oMail.Recipients.Add ("someone#example.com")
oMail.Recipients.ResolveAll
oMail.SendUsingAccount = oAccount
oMail.Send
End If
Next
End Sub
To make sure the From label shows the right value, you need to set the PR_SENT_REPRESENTING_EMAIL_ADDRESS property (DASL name http://schemas.microsoft.com/mapi/proptag/0x0065001F) using MailItem.PropertyAccessor.SetProperty.
I'm trying to forward emails from my company's Outlook to an email account outside of our company. I have been given the ok to do this.
I'd like to forward any email that contains "Excel Friday" in the subject line.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item
If Msg.Subject = "Excel Friday" Then
Dim myMail As Outlook.MailItem
Set myMail = Msg.Reply
myMail.To = "xxxxxx#fakemail.com"
myMail.Display
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I'd like to forward any email that contains "Excel Friday" in the subject line to another email address.
But in the code you check for the exact match of the subject line:
If Msg.Subject = "Excel Friday" Then
Instead you need to look for a substring. To find the position of a substring in a string, use Instr function.
If Instr(Msg.Subject, "Excel Friday") Then
Also I have noticed that you use the Reply method:
Set myMail = Msg.Reply
Use the Forward method instead:
Set myMail = Msg.Forward
And then use the Send method.
myMail.Recipients.Add "Eugene Astafiev"
myMail.Send
Be aware, the code is based on the ItemAdd event handler. This event is not fired when a large number of items are added to the folder at once (more than 16).
You can do this using a Run a Script rule
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = "Test"
Item.Save
Set olForward = Item.Forward
olForward.Recipients.Add "Jasonfish11#domain.com"
olForward.Send
End Sub
If a vba you can run on all messages in a folder at any time.
Paste into ThisOutlookSession and run
Sub ChangeSubjectThenSend()
Dim olApp As Outlook.Application
Dim aItem As Object
Set olApp = CreateObject("Outlook.Application")
Set mail = olApp.ActiveExplorer.CurrentFolder
For Each aItem In mail.Items
aItem.Subject = "New Subject"
aItem.Save
Set olForward = aItem.Forward
olForward.Recipients.Add "Jasonfish11#domain.com"
olForward.Send
Next aItem
End Sub
source Link
I want to write a VBA script that when Outlook receive a new email from a specific email address , the VBA script has to detect that and resend the new received email to all contacts in the address book .
For now i was able to send an email to all contacts in address book :
Sub SendEmails()
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim Contact As Object
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
For Each Contact In ContactsFolder.Items
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.Subject = "Subject of the received email"
.Body = "Body of the received email"
.To = Contact.Email1Address
.Send
End With
Next
End Sub
but how to use this script so it called when a new email received from a specific email address.
i tried to put this in ThisOulookSeassion to check for new message event so i could call my above code within it :
Private Sub Application_NewMail()
MsgBox "New mail"
End Sub
but it didn't work.
Also i tried this (i put it in ThisOulookSeassion too) :
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' and placing my code here.
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
but when i click run it ask me to create new macro and don't run the code.
Any suggestions ?
The simplest way is to create a rule in Outlook. Then you can assign an existing VBA macro to run when the rule is run. Typically a VBA sub should like the following one:
Sub SendEmails(mail as MailItem)
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim objMail as MailItem
Dim Contact As Object
For Each Contact In ContactsFolder.Items
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.Subject = mail.Subject
.Body = "Body Text"
.To = Contact.Email1Address
.Send
End With
Next
End Sub
Also you may consider adding recipients to the Recipients collection and set their Type to the olBCC value. Thus, each of them will recieve a separate email and you have to submit only a single mail item.