I am logged in with two Outlook Accounts, and I need to send an e-mail with the one that is not set to default.
I tried using .SendOnBehaulfOfName, but even though it showed me the right account prior to sending the email, after I sent it I saw that it was sent from the default email (which is the wrong one).
I also tried using .SendUsingAccount but it did not change the "From" email.
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim ol As Outlook.Application
Set ol = New Outlook.Application
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = lista_envio
.CC = ""
.BCC = ""
.Subject = assunto_email
.Display '
.HTMLBody = mensagem
.Attachments.Add (caminho)
.SendUsingAccount = ol.Session.Accounts("Contato")
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Set ol = Nothing
Using the For each Account in Outlook.Application.Session.Accounts method also doesn't work.
Any ideas on what is wrong?
Thanks
Make sure that such an account configured in Outlook. If you want to see changes on the Outlook UI you need to call the Display methods after setting all properties via the Outlook object model.
If the other account is configured in Outlook (not just an additional store) you need to choose the MailItem.SendUsingAccount property which sets an Account object that represents the account under which the MailItem is to be sent. You could find the following sample code which demonstartes how to use it:
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
Set oMail.SendUsingAccount = oAccount
oMail.Send
End If
Next
End Sub
The SendOnBehaulfOfName property doesn't require an account configured in Outlook. Only permissions are required for sending on behalf of another person in Exchange.
Related
So i have developed a tool wherein there are set of email templates that can be chosen for reply. I am trying to work the tool to reply to an active email or selected email.
The tool works when you have selected an email in outlook. The problem is it won't work when for example you have opened a saved email in a shared folder, instead of replying to that opened email (saved from the folder) the tool actually open the selected email in outlook instead.
Dim OutlookApp as object
Dim outlookmail as object
Set OutlookApp as GetObject(, "Outlook.application")
Set outlookmail = OutlookApp.ActiveExplorer.Selection.Item(1).ReplyAll
If checkbox1.value = true then
.bodyformat = olFormatHTML
.display
.HtmlBody = 'mssg
End if
End sub
I am trying to send a form as a table in Outlook once clicking a button in the sheet. I tried writing a code to take it as a snapshot and it worked but this gave me a hard time while using power query to compile some date from the sent emails .. and I figured out that I have to have the table in the body and not as a snapshot.
I can't seem to figure where is the problem exactly as I am a novel user of VBA.
Private Sub CommandButton2_Click()
Dim outlook As Object
Dim newEmail As Object
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("FX Request Form")
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(olMailItem)
With newEmail
.to = "belsawy#banquemisr.com"
.CC = ""
.bcc = ""
.Subject = sh.Range("C9").Value
.Body = ""
Dim xInspect As Object
Dim pageEditor As Object
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
sh.Range("B2:C21").Copy
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.Paste
.Send
Set oageEditor = Nothing
Set xInspect = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing
MsgBox "Your Request Has Been Sent To The Concerned Departments,Thank You"
End Sub
I had same problem as you.
You have to add ‚.Display’ before ‚Dim xInspect As Object’
After ensuring that references for outlook are enabled, I think you've got a few general issues.
For your code, you would want to dimension such that:
Private newEmail As Outlook.MailItem, outlook As Outlook.Application
Set outlook = CreateObject("Outlook.Application") 'YOU SPELLED THIS WRONG (forgot the T in outlook)
Set newEmail = outlook.CreateItem(olMailItem)
From there, your code seems like it should fit.
What you really need to do is put Option Explicit at the top of your module, outside of all subroutines, to make sure you can see where "new variables" are being used.
I am trying to modify the HTML body of an Outlook email, based on a template, from Excel VBA.
My code is:
Sub Email_Button()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("S:\some\path\to\file\Email.oft")
With OutMail
.Importance = olImportanceHigh
.Subject = "Subject " & Date
.Attachments.Add Application.ActiveWorkbook.FullName
.HTMLBody = WorksheetFunction.Substitute(OutMail.HTMLBody, "%target%", "replacement")
.Display
End With
' *** TIDY UP ***
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
The question is very similar to this.
I get
Run Time Error 287. Application-defined or object-defined error
on the .HTMLBody modification line.
If I remove this line the email is displayed for the user to check before hitting send.
I have referenced the Microsoft Outlook 15 Object Library.
I added:
With OutMail
.bodyFormat = olFormatHTML
But got the same error on the Substitute line so I changed the substitute to:
.HTMLBody = "<HTML><BODY>Some HTML text here</BODY></HTML>"
And the body of the email was updated.
So the error is only present when trying to use substitute or its to do with the oft.
It looks like from the debugger that there is no HTML body:
I have confirmed that body type is set to HTML both programmatically:
and by opening the oft message and checking:
The cause of the issue can be related to the Substitute method, so I'd suggest running the following code to make sure everything works correctly:
Sub CreateHTMLMail()
Dim OutApp As Outlook.Application
Set OutApp = CreateObject("Outlook.Application")
'Creates a new email item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create email item
Set objMail = OutApp.CreateItemFromTemplate("S:\some\path\to\file\Email.oft")
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
Another aspect is Outlook security prompts. Read more about that in the "A program is trying to send an e-mail message on your behalf" warning in Outlook article.
The most probable cause is Outlook Security.
For security purposes, the HTMLBody, HTMLEditor, Body and WordEditor properties all are subject to address-information security prompts because the body of a message often contains the sender's or other people's e-mail addresses.
You can find the security configurations in HKCU\Software\Policies\Microsoft\office\16.0\outlook\security\
(change 16.0 to your office version)
There are two values that you can check, promptoomaddressbookaccess and promptoomaddressinformationaccess
Change them to 2 (or ask your system administrator), restart Outlook and try again.
More info https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
I want to save the email in my local folder, and I saw this link
https://www.mrexcel.com/forum/excel-questions/361751-vba-saving-email-only-after-send-pushed.html
which basically use the class module to save the email after sending it out.
However the problem is, the email saved is the preview email (email that is being displayed before you send the email) instead of sent email (email in which you cannot edit anything anymore)
Dim cls_OL As New clsOutlook
Public objMail_SentMsg As Object
Public Emailpath As String
Sub SendEmail()
Dim OutMail As Object
Set cls_OL.obj_OL = CreateObject("Outlook.Application")
cls_OL.obj_OL.Session.Logon
Set OutMail = cls_OL.obj_OL.CreateItem(0)
Set objMail_SentMsg = OutMail
Emailpath = "V:\test\emailname.msg"
With OutMail
On Error Resume Next
'Assume this all strings variables are fine
.HTMLBody = strmsgContent1 & strmsgContent2
.to = ToEmail
.CC = CC
.BCC = BCC
.Subject = Subject
.Display
End With
Set OutMail = Nothing
End Sub
Option Explicit
Public WithEvents obj_OL As Outlook.Application
Private Sub obj_OL_ItemSend(ByVal Item As Object, Cancel As Boolean)
objMail_SentMsg.SaveAs Emailpath
Set obj_OL = Nothing
End Sub
It saved the email succesfully but as mentioned, only saved the preview/display email not the sent email.
Thank you so much for your help.
Instead of ItemSend monitor the SentItems folder with ItemAdd.
Do not save objMail_SentMsg, save the item identified by ItemAdd as being added to the folder.
If necessary to differentiate mail not to be saved, set up some unique characteristic in the mail when it is created.
I am trying to write a simple program to automatically send emails from a list in excel, and it works, but outlook keeps opening pop ups asking for permission. How do you get outlook to not ask for permission anymore and just do what excel tells it without the pop ups
Heres the code I have so far:
Sub SendMessage()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim recemail
Dim i As Integer
i = 1
recemail = Sheet1.Cells(i, 1)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(recemail)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "TEST!"
.Body = "DOES THIS WORK!?"
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
i = i + 1
End Sub
This is a manual operation that you need to do :
Run Outlook as Administrator
Go to Tools (Outlook 2007) or File, Options (Outlook 2010 and up)
Go to Trust Center
Change the Programmatic Access setting to : Never warn me about suspicious activity
You can now close Outlook and from now on, you'll have access every time without the popup!
BTW, to avoid opening a new instance of Outlook (if there is already one), use this :
'Create or Get the Outlook session.
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set objOutlook = CreateObject("Outlook.Application")
On Error GoTo 0