I'm trying to send and email with an attachment with VBA. The code works fine without the Attachments.Add line, but with it it get the error "Run-time error '440': The operation failed."
I've looked online and can't seem to find a reason for this. Am I not setting the email object correctly?
Code below:
Sub test()
Static objOutlook
Dim objMailItem
Dim objFileSystem
Dim objNamespace
Dim objSentFolder
Const olFolderInbox As Long = 6
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Session.GetDefaultFolder(olFolderInbox).Display
objOutlook.ActiveExplorer.WindowState = WindowState
Set objMailItem = objOutlook.CreateItem(0)
objMailItem.Display
With objMailItem
.Subject = "test"
Set recip = .Recipients.Add("cats#cats.com")
.Attachments.Add = "file.xls"
.Body = ""
.DeleteAfterSubmit = False
End With
objMailItem.Send
Set objFileSystem = Nothing
Set objMailItem = Nothing
Set objOutlook = Nothing
End Sub
.Attachments.Add "file.xls"
there is no = required (or allowed...)
If you're not doing so already, you should pass the full path to the file, and not just the name, otherwise your code may fail if the current directory is not what you expect.
Related
What I'm trying to do is make a loop to send an email to a list of people, with each person receiving their own excel file. The first part hasn't been set up, so I have placeholder information for who it's going to, but I'm having problems with attachments. The program works fine without the attachments line, but when I add that, I get the aforementioned error, and I'm stumped on how to fix it.
Sub AttachAndEmail()
Dim fileDirectory As String
Dim fileCriteria As String
Dim fileName As String
Dim emailApplication As Object
Dim emailItem As Object
On Error Resume Next
Set emailApplication = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)
On Error GoTo 0
Application.ScreenUpdating = False
fileDirectory = "C:\Users\DW1085\Downloads\a\"
fileName = Dir(fileDirectory)
Do While Len(fileName) > 0
emailItem.to = "Myname#email.com"
emailItem.Subject = "WowweWow"
emailItem.Body = "Yup"
emailItem.Attachments.Add fileName
emailItem.Display
fileName = Dir
Loop
Application.ScreenUpdating = True
End Sub
The Attachments.Add method creates a new attachment in the Attachments collection. The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment. So, you need to pass a full path to the file you want to be attached. For example:
Sub AddAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\Test.doc", olByValue, 1, "Test"
myItem.Display
End Sub
I am looking for VBA code in excel to reply to a selected mail but the below code creates seperate mail which does not have previous messages in conversation (thread) in body. I searched online, but most of them are old codes which are not working currently. Please help.
Sub Test_template()
Dim emailApplication As Object
Dim emailItem As Object
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.ActiveExplorer.Selection.Item(1).ReplyAll
emailItem.bcc = "XYZ.com"
emailItem.Body = "Hi, have a nice day "
emailItem.Display
Set emailItem = Nothing
Set emailApplication = Nothing
End Sub
Is this what you are trying? I have commented the code and provided relevant MSDN links. If you still get stuck then simply ask.
Option Explicit
Sub Sample()
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1)
'~~> Get MailItem.GetConversation method (Outlook)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getconversation
Dim OutlookConversation As Object
Set OutlookConversation = OutlookMail.GetConversation
'~~> Conversation.GetTable method (Outlook)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.conversation.gettable
Dim OutlookTable As Object
Set OutlookTable = OutlookConversation.GetTable
'~~> Obtains a 2D array from the Table.
' https://learn.microsoft.com/en-us/office/vba/api/outlook.table.getarray
Dim OutlookAr As Variant
OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)
Dim OutlookReplyToThisMail As Object
Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))
Dim MyMessage As String: MyMessage = "Hi, have a nice day "
With OutlookReplyToThisMail.ReplyAll
.BCC = "XYZ.com"
.HTMLBody = MyMessage & .HTMLBody
.Display
End With
End Sub
.ReplyAll produces the expected result but is overwritten by emailItem.Body = "Hi, have a nice day ".
Option Explicit
Sub Test_template()
Dim emailApplication As Object
Dim emailItem As Object
'Set emailApplication = CreateObject("Outlook.Application")
' mail has to be slelected in Outlook application so it has to be open already
Set emailApplication = GetObject(, "Outlook.Application")
Set emailItem = emailApplication.ActiveExplorer.Selection.Item(1).ReplyAll
emailItem.BCC = "XYZ.com"
'emailItem.Body = "Hi, have a nice day "
emailItem.Body = "Hi, have a nice day " & emailItem.Body
' or
'emailItem.htmlBody = "Hi, have a nice day " & emailItem.htmlBody
emailItem.Display
Set emailItem = Nothing
Set emailApplication = Nothing
End Sub
Error received: User-defined type not defined on
Dim oapp As Outlook.Application
Desired result: I have 2 tabs Sheet 1 and Email tab
I wish to take a screenshot of cells B8 TO M108 and send it to my desired recipients in the email body
I have the following code. I am not sure how to proceed.
Could I lend some help?
Sub sendemail()
Application.ScreenUpdating = False
Dim oapp As Outlook.Application
Dim email As Outlook.MailItem
Set oapp = New Outlook.Application
Set email = oapp.CreateItem(olMailItem)
email.To = Worksheets("Email").Range("A10").Value
email.CC = Worksheets("Email").Range("B10").Value
email.HTMLBody =
email.Subject = "Snapshot"
email.Display True
End Sub
Late binding could help.
dim oapp as object, email as object
set oapp = createobject("outlook.application")
set email = oapp.createitem(0)
with email
.To = Worksheets("Email").Range("A10").Value
.CC = Worksheets("Email").Range("B10").Value
.HTMLBody = ""
.Subject = "Snapshot"
.Display
End With
set oapp = Nothing
set email = Nothing
In Tools/Preferences...
add Microsoft Outlook ##.# Object Library.
Just check it.
##.# - Number of your office.
I have written this very simple code to attach a file in my email, but the email comes without an attachment.
It doesn't even throw any error. I have made sure that the path is correct and the file exists.
Please help
Private Sub CommandButton2_Click()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim Source_File As String
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "arushi.agarwal#in.ab-inbev.com"
.Subject = "This is a test message k"
.Body = "Please use this template for your weekly meeting today"
.Send ' SEND MESSAGE.
.AddAttachment ("C:\Claims\Try.docx")
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
ErrHandler:
'
End Sub
I have made minor changes in your code and it works for me. You also need to attach the file before sending the email (e.g. .attachment before .send)
Private Sub CommandButton2_Click()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim Source_File As String
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "arushi.agarwal#in.ab-inbev.com"
.Subject = "This is a test message k"
.Body = "Please use this template for your weekly meeting today"
.Attachments.Add ("C:\Claims\Try.docx")
.Send ' SEND MESSAGE.
'.AddAttachment ("C:\Claims\Try.docx")
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
Exit Sub
ErrHandler:
Range("A1").Value = Err.Description
End Sub
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