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

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

Related

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

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.

Mail Item Send Method failing for Windows Authenticated Outlook Client when closed

I am currently having an issue around automatically sending emails via excel vba?
I have a simple example:
Sub sendOutlookEmail()
Dim oApp As Outlook.Application
Dim oMail As MailItem
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "Body of the email"
oMail.Subject = "Test Subject"
oMail.To = "someone#somewhere.com"
oMail.Send
Set oMail = Nothing
Set oApp = Nothing
End Sub
This works fine when an outlook client is open. When outlook is closed I receive the following error:
Error 287: Application-defined or object-defined error
Now if I add a single line of inconsequential code above the oMail.Send Command:
Debug.Print oApp.Session.Accounts.Item(1).DisplayName
Now the code works fine regardless of Outlook open or closed.
I am aware that Windows Authentication is required to auto send an email via the OLE when Outlook is closed and is using LDAP, but as the extra code is unchanging of the sub routine. I believe this is some sort of bug around the initialisation of the Outlook.application.Session.Account default object.
Could you please help is this an LDAP issue or a Outlook.Application class issue, This is a replicated error from a VB app that I do not have access to the source code for, but is behaving in the same way and reporting the same error.
Thank You
The reason for this behaviour is stated here:
http://msdn.microsoft.com/en-us/library/office/ff861594%28v=office.15%29.aspx
Code example-
' Start Outlook.
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
' Get a session object.
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI")
' Create an instance of the Inbox folder.
' If Outlook is not already running, this has the side
' effect of initializing MAPI.
Dim mailFolder As Outlook.Folder
Set mailFolder = olNs.GetDefaultFolder(olFolderInbox)
' Continue to use the object model to automate Outlook.
"Starting in Outlook 2010, if you have multiple profiles, you have configured Outlook to always use a default profile, and you use the Logon method to log on to the default profile without prompting the user, the user will receive a prompt to choose a profile anyway. To avoid this behavior, do not use the Logon method; use the workaround suggested in the preceding InitializeMAPI example instead."*
The 'workaround' as Microsoft calls it is to simply make a statement to the Namespace object. This initializes the MAPI. It appears that when communicating remotely through the OLE interface, the Outlook application object might not be visible and the prompt to choose a profile might not be displayed, giving the appearance that nothing is happening.
Thanks Mark for helping me to identify the problem.
Tom Feuerstake
Try to add a call to Namespace.Logon:
Set oApp = CreateObject("Outlook.application")
set oNS = oApp.GetNamespace("MAPI")
oNS.Logon

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 from a shared mailbox without using sentOnBehalfOf

I'm currently using outlook.application to send mail from a shared mailbox.
I need a way to send these messages without my email address appearing on the 'from' list. It should only be the shared mailbox appearing. At the moment i'm using .sentOnBehalfOf, is there something else i should be using?
Request Send As permission.
http://social.technet.microsoft.com/Forums/office/en-US/7fd3e945-092a-461b-afa9-a126b8cc3cdd/configure-outlook-to-send-as-permissions
You should be able choose the shared account in the From field of email.
Use .SendUsingAccount to specify the shared account in VBA.
http://www.rondebruin.nl/win/s1/outlook/account.htm
Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
Dim OutApp As Outlook.Application
Dim I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub
The shared account will likely be 2.
With OutMail
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
End With

Outlook 2013 using VBA to Send Drafts

Good morning,
Using Outlook 2010 I compiled code to send all emails that were saved in a drafts folder of a given account. Now I've upgraded to Office 2013 I am getting an error... It is the .Send bit where it falls over and presents the error message:
"This method can't be used with an inline response mail item."
I am certain that there is a v simple method for sending drafts, but I have scoured the web and can't figure it as yet.
Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder. This will need modification based on where it's
Set myDraftsFolder = myFolders("accounts#credec.co.uk").Folders("Drafts")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) ] 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
I know this is old, but in case someone elses is looking for an answer:
"Active Inline Response" refers to a draft that is open in Outlook. So, when you are debugging, close the draft and flip back to a different message. Then see if your code will run.
I found that if you have clicked on the draft folder so that the Draft folder is active, then you get that error message, usually on the email in the folder that is highlighted.
SOLUTION: Click on any other folder, then run the code, should work, mine did!