I have code that sends emails using the default Outlook account.
I tried changing the code to send from a specific email. When I run the macro, nothing happens.
Is something wrong with the code, or is it not working due to another issue (with Outlook and the accounts/permissions associated with it)?
Sub CommandButton1_Click()
Dim wb As Workbook
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim q As Long
Dim oAccount As Outlook.Account
Set wb = ThisWorkbook
For Each oAccount In Outlook.Application.Session.Accounts
If oAccount = "theEmailiWantToUse#domain.com" Then
For q = 2 To 3 'LastRow
eName = wb.Sheets(1).Cells(q, 2).Value
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
mailBody = "Hello, "
With olMail
.To = Worksheets("Emails").Cells(q, 4).Value
.Subject = eName
.HTMLBody = "<!DOCTYPE html><html><head><style>"
.HTMLBody = .HTMLBody & "body{font-family: Calibri, ""Times New Roman"", sans-serif; font-size: 14px}"
.HTMLBody = .HTMLBody & "</style></head><body>"
.HTMLBody = .HTMLBody & mailBody & "</body></html>"
Set .SendUsingAccount = oAccount
.Display
' .Send
End With
Next
Else
End If
Next
Set olMail = Nothing
Set olApp = Nothing
End Sub
I know I have access to the email I would like to send emails from, as I can select it from Outlook and it works.
Add this line within the olMail
.SentOnBehalfOfName = "youraddress" 'here change this
please use this routine to find Account number of sender .
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
Then
.SendUsingAccount = olApp.Session.Accounts.Item(5)' whatever account index number you want to send. i have chosen 5
instead of
Set .SendUsingAccount = oAccount
This method works for me . You can further integrate this concept in your programme. Please ensure Reference to Outlook Object Library is set in Tools/References.
Related
I have a script that searches a group inbox subfolder and replies to the first email with a matching subject. It then replies to all. When I populate the email I cannot add my text to the rest of the email. Only either or.
I've seen many responses to similar problems that show .HTMLBody = "test" & .HTMLBody as a solution but when the debug reaches this line, the second .HTMLBody is shown as 'application-defined or object-defined error'.
Any insight into whats causing the problem or where else I can get the info from previous emails in the chain to input it that way would be greatly appreciated.
Thanks,
Sub Find_Email()
Dim olMail As Outlook.MailItem
Dim olReply As Outlook.MailItem
Dim olItems As Outlook.Items
Dim olNS As Namespace
Dim olMailbox As Folder
Dim olFolder As Folder
Dim subFolder As Folder
Dim BodyText As String
Set olNS = GetNamespace("MAPI")
Set olMailbox = olNS.Folders("Group_Inbox")
Set olFolder = olMailbox.Folders("test_Folder")
Set subFolder = olFolder.Folders("test_subFolder")
Set olItems = subFolder.Items
TheDate = Format(Date, "DD-MM-YYYY")
TheDate1 = Format(Date, "YYYY-MM")
TheDate2 = Format(Date, "YYYYMMDD")
TheDate3 = Format(Date, "YYYY")
'Find most recent email and populate
olItems.Sort "ReceivedTime", True
For i = 1 To olItems.Count
Set olMail = olItems(i)
If InStr(olMail.Subject, "Desired_Subject " & TheDate) > 0 Then
Set olReply = olMail.ReplyAll
With olReply
.Display
.To = "Recipients#gmail.com"
.CC = ""
.Subject = "Test_Subject"
'.Attachments.Add "Document_destination"
.BodyFormat = olFormatHTML
.HTMLBody = "This is a test email sending in Excel" & .HTMLBody ' This is the problem line.
Exit Sub
End With
End If
Next i
End Sub
'I understand that it might be the fact it is in a group inbox, which means that it could work for you but 'still may not work for me.
'Thanks again,
Try this (i can't test it, just a thought )
'Somewehere declare this string variable
Dim incomingHTMLBody as string
olItems.Sort "ReceivedTime", True
For i = 1 To olItems.Count
Set olMail = olItems(i)
If InStr(olMail.Subject, "Desired_Subject " & TheDate) > 0 Then
incomingHTMLBody = olMail.HTMLBody
Set olReply = olMail.ReplyAll
With olReply
.Display
.To = "Recipients#gmail.com"
.CC = ""
.Subject = "Test_Subject"
'.Attachments.Add "Document_destination"
.BodyFormat = olFormatHTML
.HTMLBody = "This is a test email sending in Excel" & incomingHTMLBody
Exit Sub
End With
End If
Next i
End Sub
You may need a bit more care referencing Outlook objects in your environment.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub Find_Email()
Dim objApp As Outlook.Application
Set objApp = CreateObject("outlook.application")
Dim objNS As Namespace
Set objNS = objApp.GetNamespace("MAPI")
Dim objMailbox As Outlook.Folder
Set objMailbox = objNS.Folders("Group_Inbox")
Dim objFolder As Outlook.Folder
Set objFolder = objMailbox.Folders("test_Folder")
Dim subFolder As Outlook.Folder
Set subFolder = objFolder.Folders("test_subFolder")
Dim objItems As Outlook.Items
Set objItems = subFolder.Items
Dim TheDate As Date
TheDate = Format(Date, "DD-MM-YYYY")
'Find most recent email and populate
objItems.Sort "ReceivedTime", True
Dim i As Long
Dim objMail As Outlook.MailItem ' olMail is not a good variable name
Dim objReply As Outlook.MailItem
Debug.Print objItems.Count
For i = 1 To objItems.Count
Debug.Print objItems(i).Subject
If objItems(i).Class = olMail Then ' verify item is a mailitem
Set objMail = objItems(i)
If InStr(objMail.Subject, "Desired_Subject " & TheDate) > 0 Then
Set objReply = objMail.ReplyAll
With objReply
.Display
.To = "Recipients#gmail.com"
.CC = ""
.Subject = "Test_Subject"
'.Attachments.Add "Document_destination"
.BodyFormat = olFormatHTML
Debug.Print .htmlbody ' verify property is available
.htmlbody = "This is a test email sending in Excel" & .htmlbody ' This is the problem line.
Exit For
End With
End If
End If
Next i
End Sub
I referenced many websites and even copied and pasted code. I cannot get my Excel macro button to send an email.
When I click RunSub/Userform(play button) in VBAProject I get
runtime error 287
Sub Send_Email()
Dim MyOutlook As Object
Set MyOutlook = CreateObject("Outlook.Application")
Dim MyMail As Object
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = "notlistedpublicly"
MyMail.Subject = Range("B6") & "Has completed his Skills Matrix"
MyMail.Body = Range("B6") & "has completed his Skills Matrix. Please review"
MyMail.Send
End Sub
I have a similar code, I added some lines to from it to your code.
Sub Send_Email()
Dim MyOutlook As Object
Set MyOutlook = CreateObject("Outlook.Application")
Dim MyMail As Object
'I change this
'Set MyMail = MyOutlook.CreateItem(olMailItem)
Set MyMail = MyOutlook.CreateItem(0)
MyOutlook.Session.Logon
With MyMail
.To = "notlistedpublicly"
.Subject = Range("B6") & "Has completed his Skills Matrix"
.Body = Range("B6") & "has completed his Skills Matrix. Please review"
'Before try to see how the mail looks.
'.Send
.Display
End with
Set MyMail = Nothing
Set MyOutlook = Nothing
End Sub
I want to send stakeholders an e-mail when a subordinate makes any updates in the Excel worksheet. I hope to use a Workbook_BeforeSave event where an e-mail is triggered from the subordinate's Outlook account.
The subordinate/user needs Outlook configured/installed in their system. If not mail wont be triggered.
Is there any way to overcome this, like sending the mail triggering request to a remote computer/server where Outlook is preconfigured and sending the mail from that computer/server to the stakeholder using a common or centralized Email id?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
Set Recipients = objOutlookMsg.Recipients
Set objOutlookRecip = Recipients.Add("receiver#domain.com")
objOutlookRecip.Type = 1
objOutlookMsg.SentOnBehalfOfName = "sender#domain.com"
objOutlookMsg.Subject = "Testing this macro"
objOutlookMsg.HTMLBody = "Testing this macro "
For Each objOutlookRecip In objOutlookMsg.Recipients
objOutlookRecip.Resolve
Next
objOutlookMsg.Display
objOutlookMsg.Send
Set OutApp = Nothing
End Sub
Option Explicit
Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.to = "webadmin#encodedna.com"
.Subject = "This is a test message from Arun Banik"
.Body = "Hi there"
.Display ' DISPLAY MESSAGE.
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
ErrHandler:
'
End Sub
All you need to do is change the .Display property with .Send property.
With objEmail
.to = "arunbanik21#rediffmail.com"
.Subject = "This is a test message from Arun"
.Body = "Hi there"
.Send ' SEND THE MESSAGE.
End With
For more please check here, https://www.encodedna.com/excel/send-email-from-excel-using-vba-and-outlook.htm
Follow the steps,
We need to send emails from Outlook. Since Outlook is an outside object first thing we need to do is to set the object reference to “Microsoft Outlook 16.0 Object Library”.
In VBA, Go to Tools > References.
Now we will see the object reference library. In this window, we need to set the reference to “Microsoft Outlook 16.0 Object Library.”
After setting the object reference, click on, Ok.
Now we can access Outlook object in VBA coding
Sub SendEmail_Example1()
Dim EmailApp As Outlook.Application 'To refer to outlook application
Set EmailApp = New Outlook.Application 'To launch outlook application
Dim EmailItem As Outlook.MailItem 'To refer new outlook email
Set EmailItem = EmailApp.CreateItem(olMailItem) 'To launch new outlook
email
EmailItem.To = "Hi#gmail.com"
EmailItem.CC = "hello#gmail.com"
EmailItem.Subject = "Test Email From Excel VBA"
EmailItem.HTMLBody = "Hi," & vbNewLine & vbNewLine & "This is my first email from Excel" & _
vbNewLine & vbNewLine & _
"Regards," & vbNewLine & _
"VBA Coder" 'VbNewLine is the VBA Constant to insert a new line
EmailItem.Send
End Sub
For more, can you please give a try as mentioned in this article,
https://www.wallstreetmojo.com/vba-send-email-from-excel/
I want to make a simple program in which I can create an Outlook Task. User fills in data and clicks the create button.
I found the following code online and it should work, but it doesn't. No task is added in my Outlook, but no error is shown either. I have the feeling it somehow goes wrong with adding the recipients of the task.
Any clue why I don't get an error but, no tasks are added?
Dim OutApp As Outlook.Application
Dim OutTask As Outlook.TaskItem
Set OutApp = CreateObject("Outlook.Application")
Set OutTask = OutApp.CreateItem(olTaskItem)
Set myRecipient = OutTask.Recipients.Add("I.wont.write.my.actual.address.in.this#example.com")
myRecipient.Type = olTo
If myRecipient.Resolved Then
With OutTask
.Display
.Subject = Cells(3, "I")
.StartDate = Now
.DueDate = Cells(2, "I")
.Body = "Please see the attached email for a service request assigned to you."
End With
End If
Set OutTask = Nothing
Set OutApp = Nothing
I just can't figure it out and it's really breaking my brain at the moment. Hope someone can hint me in the right direction!
I found the following code online and it should work, but it doesn't. No task is added in my Outlook, but no error is shown either. I have the feeling it somehow goes wrong with adding the recipients of the task.
Correct - Attempt to resolve the Recipient object myRecipient.Resolve against the Address Book before assuming its resolved If myRecipient.Resolved Then also defined variable Dim myRecipient As Outlook.Recipient for myRecipient
Option Explicit
Sub tasks()
Dim OutApp As Outlook.Application
Set OutApp = CreateObject("Outlook.Application")
Dim OutTask As Outlook.TaskItem
Set OutTask = OutApp.CreateItem(olTaskItem)
Dim myRecipient As Outlook.Recipient
Set myRecipient = OutTask.Recipients.Add("0m3r#Email.com")
myRecipient.Type = olTo
myRecipient.Resolve
If myRecipient.Resolved Then
With OutTask
.Display
.Subject = Cells(3, "I")
.StartDate = Now
.DueDate = Cells(2, "I")
.Body = "Please see the attached email."
End With
End If
Set OutTask = Nothing
Set OutApp = Nothing
End Sub
Option Explicit Statement (Visual Basic)
Forces explicit declaration of all variables in a file, or allows implicit declarations of variables.
Check this examples, run each one and see if they are usefull to you, hope one fit your needs:
Sub outlook_send_followup()
' High importance = 2
' Nothing = 1
' Low importance = 0
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim MyItem As Object
Set MyItem = OutApp.CreateItem(olMailItem)
With MyItem
.To = "example#hotmail.com"
.Subject = "hi, this is a task"
.SentOnBehalfOfName = "example#hotmail.com"
.HTMLBody = "<HTML MSG FORMAT HERE>"
.Importance = 1
.FlagStatus = olFlagMarked
.FlagRequest = "Follow up"
.FlagDueBy = Now
.Display
End With
Set MyItem = Nothing
Set OutApp = Nothing
End Sub
Sub create_outlook_taks()
'Const olImportanceLow = 0
'Const olImportanceNormal = 1
'Const olImportanceHigh = 2
Dim outlook_app As Object
Set outlook_app = CreateObject("Outlook.Application")
With outlook_app.CreateItem(3)
.Importance = 2
.Subject = "THIS IS A TASK"
.StartDate = Now + 5
.DueDate = Now + 10
.ReminderTime = Now - 3
.Body = "HI YOU CREATED THIS TASK"
.Display
'.Save
End With
Set outlook_app = Nothing
End Sub
I am trying to "replytoall" with a given format in the Body.
I use the following code to search for and display the mails.
Sub Test()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 1
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "Application for Privilege Leave - Leave ID - Dev-PL-45252-4") <> 0 Then
olMail.Display
i = i + 1
End If
Next olMail
End Sub
I need to Replyall with the same subject and a prescribed body and signature.
It is similar to when we open up a mail in Outlook and click on the Reply to All button.
I want it triggered from Excel.
Since you are using Early Binding, Change
Dim olMail As Variant
to
Dim olMail As Outlook.MailItem
And then you will be able to access all the properties of the olMail item. One of which is .ReplyAll
ScreenShot
If InStr(olMail.Subject, "Blah Blah") <> 0 Then
olMail.Display
olMail.ReplyAll
DoEvents
'
'~~> Rest of the code
'
i = i + 1
End If
There is a ReplyAll method which returns a mail object. See here.
So if you are iterating through some mails, then this should work:
For Each oMail in Fldr.Items
If InStr(olMail.Subject, "mysubject") <> 0 Then
With oMail.ReplyAll
.Subject = oMail.Subject '~~> this is optional
.Body = "your Body"
'~~> all other stuff you need your mail to have
.Display '~~> change to .Send if it is already ok
End With
End If
Next
Not tested but should be close.
Try this one:
olMail.ReplyAll
olMail.ReplyAll.body = bodyMail & vbLF & .body