I am trying to send an email by pressing a button. Everything works fine other than the body of the email. It always shows up blank. The body is being typed into TextBox1 (NOT User Form). I was hoping that putting it in a textbox would format it when sending the email.
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim ChartName As String
Set OutApp = CreateObject("Outlook.Application")
ChartName = Environ$("temp") & "\Chart4.gif"
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
ActiveWorkbook.Worksheets("Send Email").ChartObjects("Chart 4").Chart.Export _
Filename:=ChartName, FilterName:="GIF"
With OutMail
.To = Range("A2")
.CC = ""
.BCC = ""
.Subject = Range("A4")
'.body is the only thing not working it always shows up blank
.Body = Worksheets("Send Email").TextBox1.Value
.Attachments.Add ChartName
.Display 'will use send when working
End With
On Error GoTo 0
Kill ChartName
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Related
I had already code for attaching the excel workbook. I just need code for attaching an email item into the email.. please assist
Try below code (change the sheet name and range as per your requirements)
Sub Mail()
Dim r As Range
Set r = Worksheets("to_Mail").Range("A1:AD69")
r.Copy
Dim OutApp As Object
Dim outMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set outMail = OutApp.CreateItem(0)
On Error Resume Next
With outMail
.HTMLBody = activeMailMessage.HTMLBody
.To = ""
.CC = ""
.BCC = ""
.Subject = "Report Complete"
Dim wordDoc As Word.document
Set wordDoc = outMail.GetInspector.WordEditor
wordDoc.Range.PasteAndFormat wdChartPicture
outMail.send
End With
End Sub
An Outlook email is generated whenever I execute a VBA code in Excel. It does not automatically send, nor do I want it to. The email is populated by cell values in a range (which are based off of the ActiveCell) and I want to programmatically capture when the email is manually sent into ActiveCell.Offset(0, 13), preferably with VBA in my current Excel program.
This is the code by which I display the email:
'Send Stock Request:
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.BodyFormat = olFormatHTML
.HTMLBody = "My eMail's HTML Body"
.To = "myrecipients#theiremails.com"
.CC = ""
.BCC = ""
.Subject = "Stock Request"
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
It can be done through VBA, but code below must be pasted in Outlook module instead of Excel, in Outlook=>ThisOutlookSession module. Also, make sure you allow macros in Outlook.
Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
Dim Xl As Object ' Excel.Application
Dim Wb As Object ' Excel.Workbook
Set Xl = GetObject(, "excel.application")
Set Wb = Xl.Workbooks("NameOfYourOpenedWorkbook.xlsb")
Wb.Activate
Xl.activecell.Offset(0, 13).Value = Date & " " & Time
End Sub
So now when you send your automatically created email manually, you will get date and time captured in your opened Workbook in ActiveCell.Offset(0, 13) cell.
Add a VBA project reference to the Outlook object model, and add this class to your excel file:
''clsMail
Option Explicit
Public WithEvents itm As Outlook.MailItem
Public DestCell As Range '<< where to put the "sent" message
'you can add other fields here if you need (eg) to
' preserve some other info to act on when the mail is sent
Private Sub itm_Send(Cancel As Boolean)
Debug.Print "Sending mail with subject: '" & itm.Subject & "'"
DestCell.Value = "Mail sent!" '<< record the mail was sent
End Sub
Then in your Mail-sending code you can do something like this:
Option Explicit
Dim colMails As New Collection
Sub Tester()
Dim OutApp As Object
Dim OutMail As Object
Dim obj As clsMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.BodyFormat = olFormatHTML
.HTMLBody = "My eMail's HTML Body"
.To = "twilliams#theravance.com"
.CC = ""
.BCC = ""
.Subject = "Stock Request"
.Display
End With
'create an instance of the class and add it to the global collection colMails
Set obj = New clsMail
Set obj.itm = OutMail
Set obj.DestCell = ActiveCell.Offset(0, 13) '<< "sent" flag goes here
' when the user sends the mail
colMails.Add obj
End Sub
I am trying to send a test mail from excel to Outlook, However I am getting error message : Run Time Error 287 in the following line :
OutMail.Send
Please find below my code:
Sub sendds()
Dim OutMail As MailItem
Dim outlookapp As Outlook.Application
Dim myInspector As Outlook.Inspector
Set outlookapp = CreateObject("Outlook.application")
Set OutMail = outlookapp.CreateItem(olMailItem)
With OutMail
.To = "email address"
.Subject = "test mail"
.Body = "Hi this is test email"
OutMail.Send 'Getting error on this line
End With
Set outlookapp = Nothing
Set OutMail = Nothing
End Sub
That is because you have incorrect email or email address format should be email#email.com or for testing purpose use .Display
Also change it to just .Send
With OutMail
.To = "email#address.com"
.Subject = "test"
.Body = "Hi this is test email"
.Send
End With
**For workaround **
With olMail
.To = "email"
.CC = ""
.BCC = ""
.Subject = ""
.Display
.Send
End With
try the below:
Public Sub emailUsFeature()
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(olMailItem)
With outMail
.To = "abc#xyz.com; def#xyz.com"
.CC = "ghi#xyz.com"
.BCC = "jkl#xyz.com"
.Subject = "This is the subject."
End With
outMail.display
End Sub
Based on the comment "when I am using outMail.display it displays the email which I want to send but I actually want to send the email" the code is too fast. It would likely as well work if you stepped through with F8.
You could use Excel's Wait to delay the send.
This should as well work for all applications and it would be the minimum waiting period.
Sub sendds_ErrorHandlerWait()
Dim OutMail As MailItem
Dim outlookapp As Outlook.Application
Dim myInspector As Outlook.Inspector
Set outlookapp = CreateObject("Outlook.application")
Set OutMail = outlookapp.CreateItem(olMailItem)
With OutMail
.To = "email address"
.Subject = "test mail"
.body = "Hi this is test email"
On Error GoTo ErrorHandler
' Err.Raise 287 ' for testing
' Err.Raise 1 ' for testing
.Send
On Error GoTo 0
End With
ExitRoutine:
Set outlookapp = Nothing
Set OutMail = Nothing
Exit Sub
ErrorHandler:
Select Case Err
Case 287
DoEvents ' To accept clicks and to allow escaping if Outlook never opens
Debug.Print " <Ctrl> + <Break> to escape"
Resume
Case Else
On Error GoTo 0
' Break on other lines with an error
Resume
End Select
End Sub
It appears your Outlook setup requires a display. If there is no fix for that situation, you may be able to use an invisible display.
Sub sendds_InspectorRatherThanDisplay()
Dim OutMail As mailItem
Dim outlookapp As Outlook.Application
Dim myInspector As Outlook.Inspector
Set outlookapp = CreateObject("Outlook.application")
Set OutMail = outlookapp.CreateItem(olMailItem)
With OutMail
.To = "email address"
.Subject = "test mail"
.body = "Hi this is test email"
Set myInspector = .GetInspector
.Send
End With
ExitRoutine:
Set outlookapp = Nothing
Set OutMail = Nothing
Set myInspector = Nothing
End Sub
I am always adding in DoEvents and Application.Wait 1 to do this.
I usually don't display the email (and it is commented out here) so it just sends in the background. Works for me every time.
You obviously have to feed this sub from another with the arguments. An example of that is also here. (for example you could have the email address, file name etc. in each row and send an email dynamically for each row)
Sub LoopThroughTable()
For i = 2 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
email_to = Sheet1.Cells(i, 4).Value
email_subject = Sheet1.Cells(i, 3).Value
email_body = Sheet1.Cells(i, 8).Value
file_path = Sheet1.Cells(i, 2).Value & Sheet1.Cells(i, 3).Value
SendOutlookMessage email_to, email_subject, file_path, email_body
Next i
End Sub
Sub SendOutlookMessage(ByVal email_to As String, ByVal email_subject As String, ByVal file_path As String, ByVal email_body As String)
emailTo = email_to
emailSub = email_subject
FullPath = file_path
HTMLBODY = email_body
DoEvents
Application.Wait 1
Dim olApp As Object
Dim olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
With olMail
.to = emailTo
.Subject = emailSub
.Attachments.Add (FullPath)
.HTMLBODY = HTMLBODY
DoEvents
'.Display
Application.Wait 1
.Send
End With
Application.Wait 1
Set olMail = Nothing
Set olApp = Nothing
End Sub
Hope that helps.
I am working on a VBA script for mailing through Outlook in Excel 2010. Everything runs fine with one exception: the .SentOnBehalfofName line will not work. Here is the complete code
Sub Mail()
' Working in Office 2010-2013
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String ' This is for the Body of the email
Dim signature As String ' This is for the email signature
On Error Resume Next
'Set OutMail = Nothing
'Set OutApp = Nothing
Dim sh As Worksheet
Set sh = Sheets("Mail")
strbody = sh.Range("C9").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail ' This inserts the email signature
.Display
End With
signature = OutMail.HTMLBody
With OutMail
'.Display
.To = sh.Range("C5")
.CC = sh.Range("C6")
.BCC = sh.Range("C7")
.Subject = sh.Range("C8").Value
.HTMLBody = "<br>" & strbody & fncRangeToHtml(sh.Range("C13").Value, sh.Range("C14").Value) & signature
.SentOnBehalfOfName = sh.Range("C4").Value
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If I remove this section the .SentOnBehalfOf works, but I lose my signature line:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail ' This inserts the email signature
.Display
End With
signature = OutMail.HTMLBody
If I put this back in the code, I get my signature line back, but I lose my ability to send on behalf of another party.
I'm looking for a solution that allows me to do both. Any help would be appreciated.
Here is my solution. I needed to move the .SentOnBehalfOfName to the first statement in the WITH Command, then .Display immediately after that. I replace the string for signature line with .HTMLBody to pull in the signature line. Code runs fine now!
I don't know why the statements need to be in this order, but it works.......
Sub Mail()
' Working in Office 2010-2013
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String ' This is for the Body of the email
On Error Resume Next
'Set OutMail = Nothing
'Set OutApp = Nothing
Dim sh As Worksheet
Set sh = Sheets("Mail")
strbody = sh.Range("C9").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = sh.Range("C4")
.Display
.To = sh.Range("C5")
.CC = sh.Range("C6")
.BCC = sh.Range("C7")
.Subject = sh.Range("C8").Value
.HTMLBody = "<br>" & strbody & fncRangeToHtml(sh.Range("C13").Value, sh.Range("C14").Value) & .HTMLBody
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I'm trying to reference cell A1 in another workbook, in a certain sheet, to be set as the "To" field in an email. Here is my code:
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Addresses = Workbooks("Test.xlsx").Sheets("Sheet2").Range("A1").Value
On Error Resume Next
With OutMail
.to = Addresses
.CC = ""
.BCC = ""
.Subject = "Confirm " & Format(Date, "mm.dd.yy")
.body = "Please see attached for your confirm. Thanks,"
.Attachments.add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
When I execute the macro, the "To" field in the email has nothing in it. The cell I am referencing definitely has a value in it. Does anyone have any suggestions?
Try moving display to the beginning. So...
With OutMail
.display