I am new to using StackOverflow, so I apologize if I leave some things out. I have been trying for awhile to get this to work however there is just one small detail that I can't seem to get. Long story short, I have a data export from my company and I use that information to send out emails with certain information in it. I created a macro that will create everything for me which includes(the email, inserting data, and all of the text). The only issue that I am having, is that my default mail signature is not included at the bottom. I have no idea why. I thought it might have been the format of the email, Plain text, HTML, Rich text, etc. however it isn't. I have my code below. Any help is greatly appreciated! Also I do understand that there is probably a much neater and cleaner way to have made the code, but I was in a time crunch.
Sub ManifestRequest()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objMail As Object
Set objMail = objOutlook.CreateItem(0)
Dim SelRange As Range
Set SelRange = ActiveSheet.Range(Selection.Address)
SelRange.Copy
With objMail
.To = ""
.Subject = "Enter Subject Here" + SelRange
.Body = "Enter Body Text Here"
.Display ' DISPLAY MESSAGE.
End With
' CLEAR.
Set objMail = Nothing
Set objOutlook = Nothing
ErrHandler:
'
End Sub
Related
I wrote a program in Excel 2010 to sift through emails in a selected Outlook 2010 folder, and pull in information from the email (html) body.
I updated to Office 2016. Since then, I get an error when using certain properties of the MailItem object. I can pull the subject of the email into Excel, but certain properties cause a "method 'body' of object'_mailItem" failed error (including the .Body and .To properties).
Below is a simplified version of the code:
Sub GatherInfo()
Dim ObjOutlook As Object
Dim MyNamespace As Object
Dim FormFolder As Object
Set ObjOutlook = GetObject(, "Outlook Application")
Set MyNamespace = ObjOutlook.GetNamespace("MAPI")
Set FormFolder = MyNamespace.PickFolder
For i = 1 To FormFolder.Items.Count
Range("A2").Select
ActiveCell.Value = FormFolder.Items(i).Subject
ActiveCell.Offset(0, 1).Value = FormFolder.Items(i).To
End Sub
This results in:
Run-time error '-2147467259(80004005)':
Method 'To' of object'_MailItem' failed
I've done some research, and wondering if Outlook 2016 security settings could be to blame.
This is a corporate email account, running on an exchange server. Do you think that could be preventing me from accessing the body/sender of the email?
It's strange that the subject property of the email works, but not the body/to properties.
Things I've ruled out:
1) I've sent both plain text and html based emails with the same result.
2) I've tried binding the Outlook objects early (Dim ObjOutlook as Outlook.Application, etc.)
I ensured there were only mail items and no calendar items, etc.
It'll trip out the first time it hits the item.To assignment. If I insert a line to resume next then it'll go through all the emails, but will only record the subject and not the .To property.
Avoid using multiple dot notation and check if you really have a MailItem object (you can also have ReportItem or MeetingItem):
set items = FormFolder.Items
For i = 1 To items.Count
set item = items.Item(i)
if item.Class = 43 Then
Range("A2").Select
ActiveCell.Value = item.Subject
ActiveCell.Offset(0, 1).Value = item.To
End If
set item = Nothing
next
set items = Nothing
I have some VBA code that I'm using to send texts from Outlook to team members of my project at work. For some background: for non-AT&T subscribers, we have no issue sending text messages from Outlook by plugging in peoples' numbers en masse into the To: field of Outlook emails. However, all AT&T subscribers will receive the text as a group message, which we want to avoid. The non-AT&T subscribers correctly receive individual texts when we do a group send.
We've written some VBA code to loop through a spreadsheet of AT&T numbers so that Outlook sends one email per AT&T number. This has been working fine for us, however, we were hoping to add some emojis into the texts that we're sending. I've done a lot of Googling and searching through stackoverflows questions, and I can't seem to find any code built for this purpose. I'm also a complete noob when it comes to VBA, and I've pieced this solution together thus far from getting help from a coworker and reading through threads on the internet. This bit about emojis has given me enough trouble that I thought I'd break down and submit this post.
For reference, here is my code:
Sub EmojiTest()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim MobileNumber As String
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Set xlApp = CreateObject("Excel.Application")
'Grab list from Excel
Set xlAtt = xlApp.Workbooks.Open("C:\Users\Username\Desktop\Spreadsheet with AT&T numbers.xlsx")
xlAtt.Activate
LastRow = xlAtt.ActiveSheet.Range("B" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
For i = 1 To LastRow
xlAtt.Activate
MobileNumber = xlAtt.ActiveSheet.Range("B" & i).Value
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.SentOnBehalfOfName = "TeamAccount#work.com"
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(MobileNumber)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Emoji Test"
.Body = "Text with emojis"
.Save
.Send
End With
Next i
Set objOutlook = Nothing
xlApp.Workbooks.Close
Set xlApp = Nothing
End Sub
This is code I never could have come up with myself due to my complete lack of experience with VBA, and limited experience coding in general. Any help is much appreciated.
Change:
.Body = "Text with emojis"
To:
.Body = "\ud83d\ude03"
Full list available here. Copy the box called Java escape string.
The \u escapes the unicode sequence, so typing "\u" and the UTF-16 sequence should let you insert any Emoji.
Some Emojis are actually 2 seperate char sequences, so you have to chain them together.
There is a solution at this link.
As per this, you paste smiley in an Excel cell and then read the cell value, it will be string with length 2, find the code of these 2 characters using AscW() and then chain them using Chrw, e.g. to have a smiley you can use ChrW(-10179) & ChrW(-8638).
I got it!
Sub EmojiTest()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim MobileNumber As String
Dim strbody As String
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Set xlApp = CreateObject("Excel.Application")
'Grab list from Excel
Set xlAtt = xlApp.Workbooks.Open("C:\Users\user\Desktop\Spreadsheet.xlsx")
xlAtt.Activate
LastRow = xlAtt.ActiveSheet.Range("B" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
For i = 1 To LastRow
xlAtt.Activate
MobileNumber = xlAtt.ActiveSheet.Range("B" & i).Value
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.SentOnBehalfOfName = "Team#work.com"
strbody = "<BODY style=font-size:11pt;font-family:Segoe UI Symbol>🎉Congrats!<p>Paragraph 2.<p>Paragraph 3.</BODY>"
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(MobileNumber)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Emoji Test"
.HTMLBody = strbody
.Save
.Send
End With
Next i
Set objOutlook = Nothing
xlApp.Workbooks.Close
Set xlApp = Nothing
End Sub
Basically, I had to convert my message into HTML. I did that using, "Dim strbody As String" at the top, and then using ".HTMLBody = strbody" in my With statement. Once I did that, it was trivial to use the HTML hex code to enter in my emoji. Here is a page with the HTML hex code that I used (🎉): http://www.fileformat.info/info/unicode/char/1f389/index.htm.
Learned a lot about using VBA doing this, so it was fun.
Thanks for your help Sam.
I receive an automated email message (in Outlook) every time a room is reserved in a scheduling system but then have to go over and mirror that reservation in another system (which necessitates checking each reservation for specific information and searching through the inbox). I am trying to determine if there is a way to pull the information from the message section (I have found some code that pulls the date received, and subject line as well as read status, but cannot determine how to pull the message body information that I need)
The code that I am running is courtesy of Jie Jenn:
Sub ListOutlookEmailInfoinExcel()
Dim olNS As Outlook.NameSpace
Dim olTaskFolder As Outlook.MAPIFolder
Dim olTask As Outlook.TaskItem
Dim olItems As Outlook.Items
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim x As Long
Dim arrHeaders As Variant
Set olNS = GetNamespace("MAPI")
Set olTaskFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olTaskFolder.Items
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
x = 2
arrHeaders = Array("Date Created", "Date Recieved", "Subject", "Unread?")
xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeaders)).Value = ""
Do
With xlWB.Worksheets(1)
If Not (olItems(x).Subjects = "" And olItems(x).CreationTime = "") Then
.Range("A1").Resize(1, UBound(arrHeaders) + 1) = arrHeaders
.Cells(x, 1).Value = olItems(x).CreationTime
.Cells(x, 2).Value = olItems(x).ReceivedTime
.Cells(x, 3).Value = olItems(x).Subject
.Cells(x, 4).Value = olItems(x).UnRead
x = x + 1
End If
End With
Loop Until x >= olItems.Count + 1
Set olNS = Nothing
Set olTaskFolder = Nothing
Set olItems = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
With the above code, I get a readout of the Subject line, the date created/received and whether or not it has been read. I am trying to see if I can, in addition, get some of the unique string data within the message itself. The format of the emails that I receive is as follows:
Message-ID: sample info
User: test
Content1: test
Content2: test
Content3: test
Please submit a service request if you are receiving this message in error.
-Notice of NEW Room Request
Sponsored By: My_example#Test.com
Event Type: Meeting
Event Title: Test
Date of Reservation: 2015-12-02
Room: 150
From: 13:00
To: 14:00
The information will vary with each request, but I was wondering if anyone had any idea on how to capture the unique strings that will come through so that I can keep a log of the requests that is much faster than the current manual entry and double-checks?
As requested in follow up, the following code splits the message body into individual lines of information. A couple of notes: I copied your message exactly from your post, then searched for "Notice of NEW Room Request". Needless to say, this string should always start the block of information that you need. If it varies, then we have to account for the type of messages that may come through. Also, you may have to test how your message body breaks up individual lines. When I copied and pasted your message into Excel, each line break was 2 line feeds (Chr(10) in VBA). In some cases, it may be only one line feed. Or it can be a Carriage Return (Chr(13)), or even both.
Without further ado, see the code below and let us know of questions.
Sub SplitBody()
Dim sBody As String
Dim sBodyLines() As String
sBody = Range("A1").Value
sBodyLines() = Split(Mid(sBody, InStr(sBody, "Notice of NEW Room Request"), Len(sBody)), Chr(10) & Chr(10))
For i = LBound(sBodyLines) To UBound(sBodyLines)
MsgBox (sBodyLines(i))
Next i
End Sub
Below is an example connecting to an Outlook session, navigating to the default Inbox, then looping through items and adding unread emails to the spreadsheet. See if you can modify the code to your needs, and post back if specific help is needed.
Sub LinkToOutlook()
Dim olApp As Object
Dim olNS As Object
Dim olFolderInbox As Object
Dim rOutput As Range
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.getNamespace("MAPI")
Set olFolderInbox = olNS.GetDefaultFolder(6) 'Gets the default inbox folder
Set rOutput = Sheet1.Range("A1")
For Each itm In olFolderInbox.items
If itm.unread = True Then 'check if it has already been read
rOutput.Value = itm.body
Set rOutput = rOutput.Offset(1)
End If
Next itm
End Sub
Alternatively, you can write code in Outlook directly that looks for new mail arrival, and from there, you can test if it meets your criteria, and if it does, it can write to Excel. Here's a link to get you started. Post back for added help.
Using VBA to read new Outlook Email?
I have a piece of basic excel to email code however, i want to know how i can make it so that it can add several different cells to the body of the email. This needs to include a few ranges as well. These ranges should only display values from cells that actually contain a value, not blank ones.
E.g.
So i'd like for example
B12 data
(line break x 2)
E15:E20 Data
(LineBreak x2)
F19:F20 Data
My code as it stands is:
Sub Send_to_Email()
On Error GoTo PROC_EXIT
Dim OL As New Outlook.Application
Dim olMail As Outlook.MailItem
Set olMail = OL.CreateItem(olMailItem)
Dim SrcSheet As Excel.Worksheet
Set SrcSheet = Sheets("Clean (2)")
With olMail
.To = SrcSheet.Range("A19").Text
.Subject = SrcSheet.Range("F19").Text
.Body = SrcSheet.Range("B19").Text
.Display vbModal
'.Send
End With
PROC_EXIT:
On Error GoTo 0
Set OL = Nothing
End Sub
I'd suggest looking into using HTMLbody instead of body. Then you can freely add your <br/> or any other formatting you want.
As an added bonus, you don't need to worry about your whitespace as you build the body string. Though obviously, you'd still want it legible as you work out your problem.
As for the ranges, check all the relevant cells and include something like:
If Range.value <> "" then
'Do Stuff
end if
I would like to paste a range of formatted Excel cells into an Outlook message.
The following code (that I lifted from various sources), runs without error and sends an empty message.
Sub SendMessage(SubjectText As String, Importance As OlImportance)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim iAddr As Integer, Col As Integer, SendLink As Boolean
'Dim Doc As Word.Document, wdRn As Word.Range
Dim Doc As Object, wdRn As Object
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set Doc = objOutlookMsg.GetInspector.WordEditor
'Set Doc = objOutlookMsg.ActiveInspector.WordEditor
Set wdRn = Doc.Range
wdRn.Paste
Set objOutlookRecip = objOutlookMsg.Recipients.Add("MyAddress#MyDomain.com")
objOutlookRecip.Type = 1
objOutlookMsg.Subject = SubjectText
objOutlookMsg.Importance = Importance
With objOutlookMsg
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
' Set the Subject, Body, and Importance of the message.
'.Subject = "Coverage Requests"
'objDrafts.GetFromClipboard
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
I think you need to call .Save on your Mail Item (objOutlookMsg) after you've made all the changes.
Put .Display before .Send,
Simple but Quick fix, your problem is the email is not refreshing with the pasted contents before it sends, forcing it to Display first gives it time...
Also make sure you have another macro which runs before this to Copy the Range into your clipboard...
There is a button in excel to do this, "Send to mail recipent" its not normally on the ribbon.
You can also use the simple mapi built into office using the MailEnvelope in VBA
.. a good article on what you are trying to do http://www.rondebruin.nl/mail/folder3/mail4.htm