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.
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