I have code for doing several tasks and would like to receive an email notification on any error. My current code works fine but I have noticed that sometimes I get 2 or 3 messages. Why it is happening so and how to fix it?
Sub PerformAll()
On Error GoTo ErrorHandler
Call RefreshQuery
Call FormatAllCells
Call BuildListWithClass
Exit Sub
ErrorHandler:
If Err <> 0 Then
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "me.you#company.com"
.Subject = "There was an error with Importer"
.Body = "Hello Sir, there was an error with Importer. Please take a look!"
.Send
End With
' CLEAR.
Set objEmail = Nothing
Set objOutlook = Nothing
End If
Resume Next
End Sub
Looks like removing Resume Next did the job
Current code:
Sub PerformAll()
On Error GoTo ErrorHandler
Call RefreshQuery
Call FormatAllCells
Call BuildListWithClass
Exit Sub
ErrorHandler:
If Err <> 0 Then
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "me.you#company.com"
.Subject = "There was an error with Importer"
.Body = "Hello Sir, there was an error with Importer. Please take a look!"
.Send
End With
' CLEAR.
Set objEmail = Nothing
Set objOutlook = Nothing
End If
End Sub
Related
In Office 2013 this VBA code was used in Excel to send email via Outlook.
Function sendMail(reciever As String, cc As String, subject As String, body As String) As Boolean
Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On Error GoTo err
With OutMail
.To = reciever
.cc = cc
.BCC = ""
.subject = subject
.BodyFormat = 2 'olFormatHTML
.HTMLBody = body
.Send
End With
sendMail = True
GoTo finally
err:
sendMail = False
finally:
Set OutMail = Nothing
Set OutApp = Nothing
End Function
In O365, on .Send command, I get
Run-time error '287'. Application-defined or object-defined error.
.Display is working.
Try the next way, please. Your adapted code should look like this:
Function sendMail(reciever As String, cc As String, subject As String, body As String) As Boolean 'functional (uneori eroare la .Send)
Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = reciever
.cc = cc
.BCC = ""
.subject = subject
.BodyFormat = 2 'olFormatHTML
.htmlBody = body
On Error Resume Next
.send
'the new part_________________________________________________
If err.Number <> 0 Then
err.Clear: On Error GoTo 0
.Save
If Not sendDrafts(reciever, subject) Then
MsgBox "Not possible to send it from ""Draft"", neither...": Exit Function
End If
End If
On Error GoTo 0
'_____________________________________________________________
End With
sendMail = True
GoTo finally
err:
sendMail = False
finally:
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Copy the next function, too (preferable, in the same standard module):
Function sendDrafts(reciever As String, subject As String) As Boolean
Dim myOutlook As Outlook.Application, nSpace As Outlook.NameSpace
Dim mpFold As Outlook.Folders, draftFolder As Outlook.MAPIFolder, i As Long
Set myOutlook = Outlook.Application
Set nSpace = myOutlook.GetNamespace("MAPI")
Set mpFold = nSpace.Folders
'Set Draft Folder (use your Outlook account):
Set draftFolder = mpFold("xxxxx#xxxx.com").Folders("Draft")
For i = draftFolder.Items.count To 1 Step -1 'Loop through Draft folder Items
If Len(Trim(draftFolder.Items.item(i).To)) > 0 Then
If draftFolder.Items.item(i).To = reciever And _
draftFolder.Items.item(i).subject = subject Then
'Send Item
draftFolder.Items.item(i).send
sendDrafts = True
Exit For
End If
End If
Next i
End Function
If it does not work in this way, neither, you have a system (security) problem, which does not allow you to programmatically send mails...
I tested on my installation and both ways works.
I have a macro that works when I am at the office.
When working from Remote system we don't have Outlook and it will generate a error that it isn't possible to create an Outlook mail.
I need a MsgBox that says on the Remote there is no Outlook and then exit sub.
Sub Mail_workbook_Outlook_1()
Dim OutApp As Object
Dim OutMail As Object
Dim bodystr As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
bodystr = "Test"
ActiveWorkbook.Save
On Error Resume Next
With OutMail
.To = Worksheets("Test").Range("D25")
.CC = Worksheets("Test").Range("D26")
.BCC = ""
.Subject = Worksheets("Test").Range("D10")
.HTMLbody = bodystr
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I tried:
Set OutApp = CreateObject("Outlook.Application")
If OutApp Is Nothing Then
MsgBox "Outlook is not open, Open Outlook and try again!"
Exit Sub
Else
Set OutMail = OutApp.CreateItem(0)
End If
bodystr = "Test"
ActiveWorkbook.Save
On Error Resume Next
With OutMail
.To = Worksheets("Test").Range("D25")
.CC = Worksheets("Test").Range("D26")
.BCC = ""
.Subject = Worksheets("Test").Range("D10")
.HTMLbody = bodystr
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Try this code, please:
On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = Outapp.Createitem(0)
If Err <> 0 Then
Err.Clear: On Error GoTo 0
MsgBox "No Outlook Application installed, or not configured": Exit Sub
End If
On Error GoTo 0
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
Mail is sent when the value in a cell of a specific row changes.
In addition we now want to send an Outlook task whenever that happens. The following first part is the email.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OutApp As Object, OutMail As Object, strbody As String
If Target.Column = 44 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Text "
On Error Resume Next
With OutMail
.To = Sheets("Param").Cells(3, 4)
.CC = ""
.BCC = ""
.Subject = "Text"
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End If
End Sub
Until here the code works. I've added the part about the task and although the code works without the IF THEN statement I can't get it to trigger with it or I get a 424 error.
Private Sub SendTask()
Dim objOut As Outlook.Application
Dim objTask As Outlook.TaskItem
Dim blnCrt As Boolean
If Target.Column = 6 Then 'modification numéro agrément
On Error GoTo CreateOutlook
Set objOut = GetObject(, "Outlook.Application")
CreateItem:
On Error GoTo 0
Set objTask = objOut.CreateItem(olTaskItem)
With objTask
.Assign
.Subject = "You need to fix this!"
.Body = "Please fix this problem by " & Format(Now + 10, "mm/dd/yy")
.DueDate = CDate(Now + 10)
.Recipients.Add ("youremail#domain.com")
.Display
End With
If blnCrt = True Then objOut.Quit
Set objTask = Nothing
Set objOut = Nothing
Exit Sub
CreateOutlook:
Set objOut = CreateObject("Outlook.Application")
blnCrt = True
Resume CreateItem
End If
End Sub
New version of the code that seems to work as intended
Private Sub Worksheet_Change(ByVal target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
If target.Column = 6 Then 'Modification of value in row 6
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olTaskItem)
With OutMail
.Assign
.Subject = "You need to fix this!"
.Body = "Please fix this problem by " & Format(Now + 10, "mm/dd/yy")
.DueDate = CDate(Now + 10)
.Recipients.Add ("youremail#domain.com")
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Den numèro d'agrément "
With OutMail
.To = Sheets("Param").Cells(3, 4)
.CC = ""
.BCC = ""
.Subject = "Fichier acquéreur: modification numéro agrément"
.Body = strbody
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End If
End Sub
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.