I'm trying to send an automated mail based on whether a checkbox is checked.
The code works perfectly without the If function. But with it, I get:
Error 438: Object doesn't support this property or method.
I'd rather keep the If function so the mail only gets sent by checking the box. Without the If function, the mail gets sent when unchecking as well.
Sub Checkbox1_Click()
Dim OutLookApp As Object
Dim Mail As Object
Dim subject_ As String
Dim body_ As String
subject_ = "Something"
body_ = "Something else"
If Sheets("Sheet1").CheckBox1.Value = True Then
Set OutLookApp = CreateObject("Outlook.Application")
Set Mail = OutLookApp.CreateItem(0)
Application.DisplayAlerts = False
With Mail
.Subject = subject_
.Body = body_
.To = "email"
.CC = "otheremail"
.Importance = 2
.Send
End With
Application.DisplayAlerts = True
End If
End Sub
You can try using the ActiveSheet.OLEObjects ("CheckBox1"). Object.Value> 0 as condition to check it.
For more information, please see the following links:
Using Control Names with the Shapes and OLEObjects Collections
Checking if a worksheet-based checkbox is checked
Related
I am working on an excel macro to send a series of emails each with a unique attachment, and one of three template emails that are saved as word documents. Everything is working well, except pulling the body of the email in from the word document. The problem seems to be with WordEditor. I get the following error
Err.Description:The operation failed.
Err.Number:-2147467259
Err.Source:Microsoft Outlook
Here is the code I have tried:
Sub SendDCLEmails()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim DCLFile As String 'Attachment that differs for each email
Dim DCLCount As Integer 'Number of emails that will be sent
Dim toList As String
Dim ccList As String
Dim CoverLetter As String 'Word document template email
Dim fileCheckDCL As String
Dim fileCheckCover As String
Dim editor As Object
'Set references to Outlook
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
On Error GoTo 0
'Set references to Word
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then Set WordApp = New Word.Application
On Error GoTo 0
Sheets("Contacts").Select
'Create email for each record on "Contacts" tab
DCLCount = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To DCLCount
DCLFile = Range("AD1").Offset(i, 0).Value & "\" & Range("AE1").Offset(i, 0).Value
CoverLetter = Range("AF1").Offset(i, 0).Value
fileCheckDCL = Dir(DCLFile)
fileCheckCover = Dir(CoverLetter)
'Run some validations and generate the toList and ccList variables.
Set WordDoc = WordApp.Documents.Open(CoverLetter)
WordDoc.Content.Copy
'Create Emails
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = toList
.CC = ccList
.Subject = Range("AG1").Offset(i, 0).Value
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
editor.Content.Paste
.Attachments.Add DCLFile
.Send
End With
WordDoc.Close savechanges:=False
End If
toList = vbNullString
ccList = vbNullString
CoverLetter = vbNullString
DCLFile = vbNullString
fileCheckDCL = vbNullString
fileCheckCover = vbNullString
Set editor = Nothing
Next i
OutlookApp.Quit
WordApp.Quit
End Sub
There is no need to use late and early-binding technologies in the VBA macros:
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
Instead, you need to use one or another. Read more about that in the Using early binding and late binding in Automation article. I'd suggest declaring all objects with real classes (early-binding), it may allow avoiding mistakes with syntax further. And use the New operator in the code instead of CreateObject one.
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
Calling the WordEditor property may sometimes fail if the Inspector is not yet visible and initialized. Try to call the Display method prior getting the Word editor value.
Also instead of relying on Word documents as templates you may create templates in Outlook and use the Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. Read more about that in the article which I wrote for the technical blog, see How To: Create a new Outlook message based on a template.
I'm calling Outlook from an Excel VBA macro to send an attachment via email. If for some reason an attachment cannot be added to the MailItem, I get the "Array index out of bounds" error when trying to display the MailItem.
When I checked value of MailItem.Attachments.Count, it showed 1, even though attachment was not added to the email. I tried removing the attachment using MailItem.Attachments.Remove 1, but count of attachments still shows 1 and the "Array index out of bounds" error still appears when trying to display.
I've come across this thread, which is about developing Office Add-Ins in C#, and it suggests releasing all COM objects. I'm not sure how to do it and if it's even relevant. I tried setting all objects except the MailItem to Nothing, but that didn't help.
UPD: The question that was suggested in comments does not solve my problem. In that question the wrong object was used to access the Attachments property. Here I'm using Outlook.MailItem.Attachments, which I believe is correct.
Here's the sample code:
Public Sub ForStackOverflow()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Attachments As Object
Dim Attachment As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
.To = "test#test.com"
.Subject = "test"
.Body = "test"
Set Attachments = .Attachments
On Error Resume Next
Set Attachment = Attachments.Add("C:\Temp\ThisFileDoesNotExist.txt")
If Err.Number = 0 Then
On Error GoTo 0
.Send '<-- This works fine because attachment was added successfully
Else
On Error GoTo 0
'Attachment.Delete 'This and any of the below didn't work
'Set Attachment = Nothing
'Attachments.Remove 1
'Set Attachments = Nothing
.Display '<-- Error 440: Array index out of bounds on this line
End If
End With
End Sub
With On Error Resume Next you found there is something indicating there is an attachment, you cannot remove, that triggers an "Array index out of bounds" error.
Test for the file instead of applying the code of last resort, On Error Resume Next.
Option Explicit
Public Sub ForStackOverflow_FileExistsTest()
Dim OutlookApp As Object
Dim MailItem As Object
Dim pathFile As String
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
pathFile = "C:\Temp\ThisFileDoesNotExist.txt"
If Len(dir(pathFile)) > 0 Then
.Attachments.Add (pathFile)
.Display
Else
MsgBox pathFile & " does not exist."
.Display
End If
End With
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.
Can I use mailitem.entryID in Excel VBA?
I have a tool using excel where I can send an outlook email to recipients using spreadsheet as the UI to display user data. I need to store the entryID of each of the emails send to the user in the excel table. Can I set in the code (excel vba) mailitem.entryID = worksheet.cells().value ? Will it retrieve the entryID? Can you give me your input regarding this? Thank you for your help.
Dim AppOutlook As Object
Dim MailOutlook As Object
Dim Emailto, ccto, sendfrom As String
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook =AppOutlook.CreateItem(0)
Emailto = worksheet.Cells().Value
ccto = worksheet.Cells().Value
sendfrom = "email"
With OutMail
.SentOnBehalfOfName = sendfrom
.To = Emailto
.CC = ccto
.BCC = ""
.Subject =
.BodyFormat = olFormatHTML
.HTMLBody = "body here"
.Send
This is my code, and I plan to add the code worksheet.cells.value = MailOutlook.entryID at the last line of the code. Is it possible? and where to add the AddItem event?
You can read the EntryID property after the message is sent. You cannot do that before or immediately after sending the message - it will be changed when the message is asynchronously sent and moved to the Sent Item folder. The erliest you can access the entry id in the Sent Items folder is when the Items.ItemAdd event fires in the Sent Items folder.
The mail item may not exist any longer after calling the Send method. It can be moved to the Outbox folder for further processing by the transport provide. Item can be marked for processing by the transport provider, not being yet sent. So, we need to handle the ItemSend event in the code.
If you need to be sure that the mail item was sent for sure I'd recommend handling the ItemAdd event of the Items class (see the corresponding property of the Folder class). For example, when an Outlook item is sent, a sent copy is placed to the Sent Items folder in Outlook. You may handle the ItemAdd event for that folder to be sure that the item was sent for sure. Consider adding a user property before displaying the Outlook item and checking it in the ItemAdd event handler to identify the item uniquely.
Demo code based on your code:
Sub Test3()
Dim AppOutlook As Object
Dim MailOutlook As Object
Dim Emailto, ccto, sendfrom As String
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook = AppOutlook.CreateItem(0)
Emailto = Worksheets("Sheet3").Cells(1, 1).Value
ccto = Worksheets("Sheet3").Cells(2, 1).Value
sendfrom = "test#outlook.com"
With MailOutlook
.SentOnBehalfOfName = sendfrom
.To = Emailto
.CC = ccto
.BCC = ""
.Subject = "Test"
.BodyFormat = olFormatHTML
.HTMLBody = "body here"
'.Display
.Send
End With
End Sub
Some ItemAdd snippet for you reference(The current event is not the right one, we still need to test it):
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
‘Private Sub Application_Startup()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim objWatchFolder As Outlook.Folder
Dim AppOutlook As Object
Set AppOutlook = CreateObject("Outlook.Application")
Set objNS = AppOutlook.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub
Private Sub objItems_ItemAdd(ByVal Item As Object)
' Your code goes here
MsgBox "Message subject: " & Item.Subject & vbcrlf & "Message sender: " & Item.SenderName &" (" & Item.SenderEmailAddress & ")"
Worksheets("Sheet3").Cells(3, 1).Value = Item.EntryID
Set Item = Nothing
End Sub
The MailItem object is part of Outlook's VBA Object library. You can see the documentation for the MailItem object on MSDN here.
To use VBA objects from a different program in Microsoft Office (eg. calling Outlook from Excel, calling Visio from Word, calling Excel from Powerpoint) you first need to make sure you have the right References selected in your Visual Basic Editor (VBE).
How to turn on Outlook references in Excel:
In Excel's VBE, go to Tools > References.
A References - VBAProject box will appear.
Under Available References: scroll down until you reach something like Microsoft Outlook 16.0 Object Library (This will differ depending on the version of Office you are using)
Tick the box and press OK.
Now the Outlook Object references have been enabled, you should be able to call Outlook objects and methods from Excel, including MailItem.
I'm using the below code to auto-generate an email.
Public Function GenerateEmail(sendToText As String, _
sendCCText As String, sendBCCText As String, _
subjectText As String, fileName As String)
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(fileName)
With OutMail
.sendTo = sendToText
.CC = sendCCText
.BCC = sendBCCText
.Subject = subjectText
.HTMLbody = WorksheetFunction.Substitute(OutMail.HTMLbody, "%TESTNUM%", "98541")
.Attachments.Add (Application.ActiveWorkbook.FullName)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
My end goal is to add data into the email and attach the active document into it as well. Everything here is working as intended, except the .HTLMbody section. It's giving me an error
"Unable to get the Substitute property of the WorksheetFunction
class."
Am I missing a reference to a library? Should I be using something different?
The email is saved as .oft format, so I have a line in the email that has %TESTNUM% that I'm looking to replace with 98541 (or any other string I need to pass into the function)
I have HTML email working in Excel using very similar code. The difference is that I build a temporary string with the text and you could do your substitute code on the string.
Then you can simply use:
.HTMLbody = temp_string
It might not be as elegant but it will help you work out where the problem is.