I am looking to auto send an email from excel vba to outlook 2013.
I am able to send the email to individuals and pass the TITUS classification, however I still get the below error when I send to a group email.
How do I select "send anyway" in VBA?
Below is the code I have to send the email:
Dim AOMSOutlook As Object
Dim AOMailMsg As Object
Set AOMSOutlook = CreateObject("Outlook.Application")
Dim objUserProperty As Object
Dim OStrTITUS As String
Dim lStrInternal As String
Set AOMailMsg = AOMSOutlook.CreateItem(0)
Set objUserProperty = AOMailMsg.UserProperties.Add("TITUSAutomatedClassification", 1)
objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies;"
With AOMailMsg
.To = "mygroup#list.company.com"
.Subject = "my subject"
.Attachments.Add Img
.HTMLBody = "my text"
.Save
.Send
End With
Set AOMailMsg = Nothing
Set objUserProperty = Nothing
Set AOMSOutlook = Nothing
Set lOMailMsg = Nothing
Set objUserProperty = Nothing
Set lOMSOutlook = Nothing
Any help greatly appreciated!
Thanks to #MattCremeens was able to resolve by adding:
.display
SendKeys "{DOWN}{DOWN}{ENTER}", True 'set classification
SendKeys "{ENTER}",True 'send to group
.send
End With
Related
Hello I have the following code written below to automatically send an email confirming that the user has filled out a form. Currently I have a powerpoint with one submit button which sends an automatic email. I also have a textbox named serial number where the user enters the part serial number.
I want to be able to send a copy of the filled out powerpoint form and have it named after the serial number. I am struggling to be able to save the textbox information as a variable. Does anyone know how to make the below functional. I apologize as I am fairly new to VBA.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Powerpoint As Presentation
Dim SerialNumtext As String
Dim FinalName As String
SerialNumtext = ActivePresentation.SelectContentControlsByTitle("SerialNumber")(1).Range.Text
FinalName = "Part Number" & SerialNumtext
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Powerpoint = ActivePresentation
Powerpoint.Save
With EmailItem
.Subject = "SUBJECT LINE"
.Body = "BODY MESSAGE" & vbCrLf & _
"SECOND LINE BODY MESSAGE" & vbCrLf & _
"THIRD LINE BODY MESSAGE"
.To = "enduseremail"
.Importance = olImportanceNormal
'send the email with the powerpoint named after the serial number
.Attachments.Add Powerpoint.FinalName
.Send
End With
Set Powerpoint = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
Powerpoint doesn't have a SelectContentControlsByTitle method; instead, you'd access the control and its text like:
SerialNumtext = ActivePresentation.Slides(1).Shapes("SerialNumber").OLEFormat.Object.Text
This assumes the control is on Slide 1.
If you'd rather not make that assumption but can assume that the Submit button and text box are on the same slide:
SerialNumText = Me.Shapes("SerialNumber").OLEFormat.Object.Text
Me in this case returns a reference to the slide object that contains the control.
I've got an Excel spreadsheet built by someone else that sends an email to a group via a scheduled task, or at least used to. It recently stopped working. I don't have the time to rebuild his whole Rube Goldberg / Wile E. Coyote system at the moment, so I'm trying to fix it.
In one of the excel documents, this code exists
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Weight").Range("A2")
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "eric.lizotte#.com"
.CC = ""
.BCC = ""
.Subject = Sheets("Weight").Range("A1")
.HTMLBody = Convert.ToString(rng)
.Send
End With
whenever I see so many "on error resume next" in something I grit my teeth.
What's happening is that it "works" but the email it sends is blank. In debug I can see that the subject content and body content both exist and have values. I rewrote it to be
OutMail.To = "eric.lizotte#.com"
OutMail.CC = ""
OutMail.BCC = ""
OutMail.Subject = Sheets("Weight").Range("A1")
OutMail.HTMLBody = Convert.ToString(rng)
OutMail.Send
and threw a debug point on the send, and checked the properties of outmail, and the subject and htmlbody have values. I can't figure out why after the send they are blank.
Given you are automating another application you probably should not rely on the default property of the range - just specify the property you want e.g. Value:
OutMail.Subject = Sheets("Weight").Range("A1").Value
OutMail.HTMLBody = rng.Value
You might also try the Text property for the HTMLBody:
OutMail.HTMLBody = rng.Text
You can then be confident that you are assigning a String to the mail properties which is what it expects.
I am trying to create a submit button in Excel 2016 using a macro with the below code
Sub Submitbutton14_Click()
Dim x As Outlook.Application
Dim y As Outlook.MailItem
Set x = CreateObject("Outlook.Application")
Set y = oLapp.CreateItem(0)
With y
.Subject = ""
.CC = ""
.To = "test#email.com"
.Body = ""
.Attachments.Add '(path to the attachment,either hard coded or
' variable)
.Display
End With
Set x = Nothing
Set y = Nothing
'
End Sub
When I run the macro I see a Compile Error: Argument not Optional with Sub Submitbutton14_Click() highlighted in yellow. Can you advise what I am doing wrong? I am completely new to VBA and have found this code online and have modified parts of it to fit my need?
Many Thanks
You need to add an attachment path
https://msdn.microsoft.com/en-us/library/office/ff869553.aspx
Source is required.
Also, you can use new outlook.application, rather than createobject.
What I have, is a similar piece of code & i made it work with the outlook editor (hard enough) and I am trying to get it to now work with Word acting as the outlook editor. (Users are used to word mail) I tried: To move the code directly into word under this document and it did nothing. To follow code i saw on: creating an objword objdoc and then pairing it with the outlook class type of deal, with no luck. Here is a sample of code:
Sub SetCategory()
Dim olMessage As Outlook.MailItem
Set olMessage = Application.ActiveInspector.CurrentItem
If olMessage.SenderName = donations Then
olMessage.Categories = "donations"
ElseIf olMessage.SenderName = "Donations" Then
olMessage.Categories = "donations"
End If
With olMessage
.Send
End With
End Sub
When using "word mail" you are not using Outlook. This describes how to invoke Outlook from Word. Once Outlook is open you can use Outlook VBA.
http://www.howto-outlook.com/howto/senddocasmail.htm
Untested, and you will have to remove the parts you do not need.
Sub SendDocAsMail()
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0 ' <=== Important to see errors now if there are any
'Create a new message
Set oItem = oOutlookApp.CreateItem(olMailItem)
' --------------------------
'Set oItem = oOutlookApp.ActiveInspector.CurrentItem
If oItem.SenderName = donations Then
oItem.Categories = "donations"
ElseIf oItem.SenderName = "Donations" Then
oItem.Categories = "donations"
End If
' --------------------------
'Allow the user to write a short intro and put it at the top of the body
Dim msgIntro As String
msgIntro = InputBox("Write a short intro to put above your default " & _
"signature and current document." & vbCrLf & vbCrLf & _
"Press Cancel to create the mail without intro and " & _
"signature.", "Intro")
'Copy the open document
Selection.WholeStory
Selection.Copy
Selection.End = True
'Set the WordEditor
Dim objInsp As Outlook.Inspector
Dim wdEditor As Word.Document
Set objInsp = oItem.GetInspector
Set wdEditor = objInsp.WordEditor
'Write the intro if specified
Dim i As Integer
If msgIntro = IsNothing Then
i = 1
'Comment the next line to leave your default signature below the document
wdEditor.Content.Delete
Else
'Write the intro above the signature
wdEditor.Characters(1).InsertBefore (msgIntro)
i = wdEditor.Characters.Count
wdEditor.Characters(i).InlineShapes.AddHorizontalLineStandard
wdEditor.Characters(i + 1).InsertParagraph
i = i + 2
End If
'Place the current document under the intro and signature
wdEditor.Characters(i).PasteAndFormat (wdFormatOriginalFormatting)
'Display the message
oItem.Display
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
Set objInsp = Nothing
Set wdEditor = Nothing
End Sub
Edit: Added, based on comment. This is a step that beginners trip on.
"Since this macro also uses Outlook functionality to create the mail we must add the reference to the project. To do this choose Tools-> References… and select Microsoft Outlook 12.0 Object Library (or 14.0 when using Outlook 2010). After this press OK."
Latest Outlook versions use Word as an email editor by default. There is no need to check out the editor type. The WordEditor property of the Inspector class returns the Microsoft Word Document Object Model of the message being displayed. You can read more about that in the Chapter 17: Working with Item Bodies .
Also you may find the How to automate Outlook and Word by using Visual C# .NET to create a pre-populated e-mail message that can be edited article helpful.
I have a macro that searches a contact list that pulls data from a list of contacts in Excel, and prepares an email to be sent in Outlook.
Most of this macro works successfully. I am almost finished.
I also need it to search a folder (using the filename to be entered in cell A8) and attach the appropriate file to the emails.
(Folder path: C:\Users\SERGIL\Desktop\VATS )
Below is the code I have thus far:
Public Sub SendEmails()
Const cSUBJECT As String = "C2"
Const cBODY As String = "C3"
Const cSTART_ROW_INDEX As String = "C4"
Const cEND_ROW_INDEX As String = "C5"
Const cMAIL_TO_COLUMN As String = "G" ' The column with the email addresses in it
Const cCOMPANY_NAME_COLUMN As String = "B" ' The column with the Vendor/Company Names in it
'Put as many email addresses here as you want, just seperate them with a semicolon
Const cCC_EMAIL_ADDRESSES As String = "C6"
Const cFROM_ADDRESS As String = "C7"
Dim iRowCount As Integer
Dim iEndRow As Integer
'Grab the current open worksheet object
Dim oSheet As Worksheet
Set oSheet = ActiveSheet
iRowCount = oSheet.Range(cSTART_ROW_INDEX).Value2 ' Get the Start Value
iEndRow = oSheet.Range(cEND_ROW_INDEX).Value2 ' Get the End Value
Dim dBatchStart As Date
Dim dBatchEnd As Date
Dim sVendorName As String
Dim sEmail As String
Dim sSubject As String
Dim sBody As String
'Outlook must already be open, attach to the open instance
Dim oOutlook As Outlook.Application
Set oOutlook = GetObject(, "Outlook.Application")
'Declare a new draft email object
Dim oMail As Outlook.MailItem
'Start iterating through all the rows of mail, creating a new draft each loop
Do Until iRowCount = (iEndRow + 1)
'Actually instantiate the new draft email object
Set oMail = oOutlook.CreateItem(olMailItem)
'Display the draft on screen to the user can see and validate it
oMail.Display
'Set the TO address based on the data in the sheet
oMail.To = oSheet.Range(cMAIL_TO_COLUMN & iRowCount).Value2
'Get the subject, also, substitute the tags for Company and Start Date with the values in the sheet
sSubject = oSheet.Range(cSUBJECT).Value2
sSubject = Replace(sSubject, "<DATE FOR THAT VENDOR GROUP>", Format(dBatchStart, "Long Date"))
sSubject = Replace(sSubject, "<COMPANY>", oSheet.Range(cCOMPANY_NAME_COLUMN & iRowCount).Value2)
'Now insert the formatted subject into the draft email
oMail.Subject = sSubject
'Get the Body, substitute the tags for Start Date and End Date with the values in the sheet
sBody = oSheet.Range(cBODY).Value2
'Now insert the formatted Body into the draft email
oMail.HTMLBody = sBody
'Now add attachments
oMail.HTMLBody = sBody
'Set the CC address based on the Constant at the top
oMail.CC = oSheet.Range(cCC_EMAIL_ADDRESSES).Value2
oMail.Save
'Set the actual sender of the name. It won't display for the user, but will actually sent as that address
oMail.SentOnBehalfOfName = oSheet.Range(cFROM_ADDRESS).Value2
oMail.Save
'The draft mail item is now complete.
'The from address will need to be changed manually.
'The user will need to actually send the email once reviewed.
iRowCount = iRowCount + 1
Loop
With objMail
.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
End Sub
-- I am receiving an error with this segment of the code:
With objMail
.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
The Add method of the Attachments class accepts four parameters. The Source parameter (the first one) should be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment.
It seems you need to replace the rngAttach.Value statement with a valid parameter (a file or Outlook object).