VBA to read save messages on an Excel sheet
 

Hi, I've been trying to write a scrip on VBA for outlook, I need that for each new email that contains a spceficid prhase in the subject, the email should be copied in Excel, the flieds that I want to copy are FROM, DATE, SUBJECT, BODY.
I tried to do this on Outlook but I couldn't. I don't know if you now how can I do this in excel. Thank you.

VBA to read save messages on an Excel sheet
 

Hi,

Am Tue, 21 Jun 2016 06:00:35 -0700 (PDT) schrieb Juan López:

Hi, I've been trying to write a scrip on VBA for outlook, I need that for each new email that contains a spceficid prhase in the subject, the email should be copied in Excel, the flieds that I want to copy are FROM, DATE, SUBJECT, BODY.
I tried to do this on Outlook but I couldn't. I don't know if you now how can I do this in excel. Thank you.

try:

Sub OutlookMail()
Dim appOL As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object
Dim n As Long
Dim varOut() As Variant

Set appOL = CreateObject("outlook.Application")
Set objNameSpace = appOL.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objItems = objFolder.Items

For Each objItem In objItems
With objItem
If .Class = olMail Then
If InStr(.Subject, "Excel") 0 Then
ReDim Preserve varOut(2, n)
varOut(0, n) = .SenderName
varOut(1, n) = .ReceivedTime
varOut(2, n) = .Subject
n = n + 1
End If
End If
End With
Next
If n 0 Then
Range("A1").Resize(n, 3) = Application.Transpose(varOut)
Columns("A:C").AutoFit
End If
End Sub


Regards
Claus B.
--
Windows10
Office 2016

VBA to read save messages on an Excel sheet
 

Hi again,

Am Tue, 21 Jun 2016 16:39:46 +0200 schrieb Claus Busch:

Sub OutlookMail()

better try:

Sub OutlookMail()
Dim appOL As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object
Dim n As Long

Set appOL = CreateObject("outlook.Application")
Set objNameSpace = appOL.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objItems = objFolder.Items

For Each objItem In objItems
With objItem
If .Class = olMail Then
If InStr(.Subject, "Hallo") 0 Then
n = n + 1
Cells(n, 1) = .SenderName
Cells(n, 2) = .ReceivedTime
Cells(n, 3) = .Subject
Cells(n, 4) = .Body
End If
End If
End With
Next
Columns("A:D").AutoFit
Rows("1:" & n).AutoFit
End Sub


Regards
Claus B.
--
Windows10
Office 2016