OUTLOOK VBA - exporting body from incoming message to excel

Arthur.J

New Member
Joined
Jun 8, 2009
Messages
44
Hey All, Hopefuly somebody will be able to help.

I would like to have a macro which is able to transfer some information from incoming email to existing excel workbook (add new line). My code is working fine but only for first email received after restarting outlook. For every next email macro is running, opening workbook and not adding any information.

Anyone is able to help?
Thanks in advance.


Code:
Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
  Set objNS = Nothing
End Sub


Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook
    Dim StrBody As String
    Dim TotalRows, i As Long

  
  
  On Error Resume Next
  Item.BodyFormat = olFormatPlain
  
  MsgBox (Item.Subject)
  
  Set myXLApp = New Excel.Application
  myXLApp.Visible = True
  Set myXLWB = myXLApp.Workbooks.Open("Z:\Leads_replies.xls")
  
  
  'adding to excel
    'Workbooks(myXLWB).Activate
    
    TotalRows = Sheets(1).Range("A55000").End(xlUp).Row
    i = TotalRows + 1
    MsgBox (myXLWB)
    
   
    StrBody = Item.Body
    Range("A" & i).Value = Format(Item.SentOn, "mm/dd/yyyy")
    Range("B" & i).Value = Item.SenderName
    Range("C" & i).Value = Item.To
    
    Range("D" & i).Value = Item.Body
  
  myXLWB.Close SaveChanges:=True
  
  myXLApp.Quit
  
  Item.Save
  Set Item = Nothing

  
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
I haven't added all the code required, but this will put the body text of each email in your inbox into the variable strBody. It'll do all emails, not just unread ones though.
You'll need to set a reference to the Outlook library.

Code:
Public Sub GetBody()

    Dim myOlapp As Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myFolder As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem
    Dim strBody As String
     
    Set myOlapp = New Outlook.Application
    Set myNameSpace = myOlapp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    
    For Each myItem In myFolder.items
        strBody = myItem.body
    
    Next myItem

End Sub
 
Upvote 0
Darren,

Thanks for reply, but actually this is not what I need - My code is putting body into variable - what I need is to add new line to excel spreadsheet when new email arrive. It works only with first email after restarting outlook.
 
Upvote 0
Ah, that's why the WithEvents statement was in there. :)

Not sure how to do it then. I would say it might be easier to program it in Outlook to push the data to Excel when a new email arrives, but programming in Outlook is scary - never could get the hang of it.

The forums on http://www.outlookcode.com/ might be better.
Edit - just looked at their forum, lots of questions not many answers.
 
Upvote 0
Ah, that's why the WithEvents statement was in there. :)

Not sure how to do it then. I would say it might be easier to program it in Outlook to push the data to Excel when a new email arrives, but programming in Outlook is scary - never could get the hang of it.

The forums on http://www.outlookcode.com/ might be better.
Edit - just looked at their forum, lots of questions not many answers.

Thanks for help anyway. It's actually very strange and can't figure it out. Macro is getting information from email when it arrives, but after first use is not able to write data to excel - is only opening and closing file.
 
Upvote 0
Upvote 0
This macro is located in outlook and run every time when macro arrives. I will check your link. Thanks for help.
 
Upvote 0
Got this one working (you need to set a reference in Outlook to Excel)

Place it in the ThisOutlookSession module in Outlook:
Code:
Private Sub Application_NewMail()

    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim myItem As MailItem

    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook
    Dim StrBody As String
    Dim TotalRows As Long, i As Long
    
    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set myItem = objFolder.Items(1)
    
    Set myXLApp = New Excel.Application
    myXLApp.Visible = True
    Set myXLWB = myXLApp.Workbooks.Add
    
    TotalRows = Sheets(1).Range("A65536").End(xlUp).Row
    i = TotalRows + 1
    
    With myXLWB.Worksheets(1)
        .Cells(i, 1) = Format(myItem.SentOn, "mm/dd/yyyy")
        .Cells(i, 2) = myItem.SenderName
        .Cells(i, 3) = myItem.To
        .Cells(i, 4) = myItem.Body
    End With
    
End Sub

It will fire whenever any new mail item arrives, and will need changing so that myXLWB opens your workbook rather than creating a new workbook for each mail item.

Edit: Had a look at the link that sous2817 posted. Looks like you can add a rule for a script to run? i.e. If email arrives from a certain address then run the script? Going to have to look into this further. :)
 
Last edited:
Upvote 0
Yeah, sorry both. I thought it was something you were doing in Excel...

Outlook programing is one of those things that I always wanted to dabble in, but never got too motivated.

Darren, if you're ever looking for a bit of a side project, a macro I'd love in Outlook would be the ability to automatically book x minutes before and after a meeting to keep me from getting booked back, to back,to back, to back....any ideas?
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top