VBA to copy e-mail message to EXCEL

[neodjandre]

Hello,

I would be grateful if someone could help me with this request. When an e-mail arrives to a specific inbox, I would like the subject line to be copied to EXCEL and then copy another cell from EXCEL and paste that to a reply e-mail automatically.

could this be done?

thanks in advance
Andy

[MaximS]

Why not to use Outlook Rules for that.

Go to Tools >> Rules and Alerts >> New Rule >> Start From a Blank Rule >> Check Messages When they Arrive

Conditions can be as follows:

- with specific words in subject
- from people or distribution list

then:
- reply with following template

make template and that's it.

To make one use below guide:

Create an e-mail template

On the Tools menu, click Options, and then click the Mail Format tab.
Clear the Use Microsoft Office Word 2003 to edit e-mail messages check box.
Click Apply, and then click OK.
On the File menu, point to New, and then click Mail Message. Note You can also start a new e-mail message by clicking the New Mail Message button on the Standard toolbar.
When the new message opens, give it an appropriate subject and compose your content. Leave space for variable information that will be added when you send the message.
On the File menu, click Save As.
In the Save as type list, click Outlook Template, and then click Save.
To restore Word as the message editor, click Options on the Tools menu, click the Mail Format tab, and then select the Use Microsoft Office Word 2003 to edit e-mail messages check box.
Click Apply, and then click OK.

[neodjandre]

hi, that's useful but how do I copy the subject line to excel ?

and then copy back to the reply email another excel cell ?

many thanks in advance

[MaximS]

Isn't that solve your problem of automatic reply whenever you've got new email with specified words in subject. You can create as many rules as you want and each of them can refere to different subject, and will sent back appropriate template. You want loose time to open excel file write in it, vlookup and come back to outlook. Plus you can do all formating (i.e adding pictures etc.) before saving templates.

Are you using that excel file as a log??

[neodjandre]

Excel performs some calculations on the subject line.. this is where the need comes from..

[MaximS]

try this code:

It is only just example which need some adjustments and extra handlers but can give you some ideas what to do and maybe others will help too.

I've found that code gots some problems with finding lastrow due to nature of Outlook.

Other piece which needs correction is part checking if file and excel is open.

Apart form that is runing.


Private Sub Application_NewMailEx _
(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim LastRow As Long
Dim ns As Outlook.NameSpace
Dim itm As MailItem
Dim m As Outlook.MailItem

If objExcel = False Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Else
Set objExcel = GetObject(, "Excel.Application")
End If

Set objWorkbook = objExcel.Workbooks.Open("C:\Folder\yourFile.xls")
Set objWorksheet = objWorkbook.Worksheets("Sheet1")

On Error Resume Next
Set ns = Outlook.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))
Set m = itm

yourSubject = m.Subject
yourRecipient = m.SenderName

With objExcel

objWorksheet.Select

' for some reasons range needs to be fixed
LastRow = objWorksheet.Range("A25").Row

objWorksheet.Range("C1").Formula = "=INDEX(B1:B" & LastRow & ", MATCH(" & yourSubject _
& ", A1:A" & LastRow & ", 0))"

objWorksheet.Range("C1").Formula = objWorksheet.Range("C1").Value

myReply = objWorksheet.Range("C1").Value

objExcel.DisplayAlerts = False

objExcel.Quit

objExcel.DisplayAlerts = True

End With
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing

' Variable Declaration
Dim objEMail As Object

' Creates a new e-mail
Set objEMail = Outlook.CreateItem(0)
With objEMail

' Adds To Recipient
Set ToContact = .Recipients.Add(yourRecipient)

' Adds CC recipient
ToContact.Type = olCC

Set ToContact = .Recipients.Add(yourRecipient)

' Sets the Subject
.Subject = "RE:" & yourSubject

' Sets the Body
.Body = myReply

' Adds attachment
'.Attachments.Add "c:\Folder\", olByValue, , "Service Report"


' Receipt upon delivery
'.OriginatorDeliveryReportRequested = True

' Recipt upon read
'.ReadReceiptRequested = True

' Displays the E-Mail
.Display

' Sends the E-Mail
.Send

' Saves a Draft of the E-Mail
.Save
End With

End Sub