Subject from Outlook to Excel

[juanpablo]

Hi,

I need to extract some information from the subject of an email and save it
in excel file.
the Subject has always the same format.
I would like to run a macro every time for all the email on one folder and
then create the excel.

Is it possible?

 

[Dave O]

It is possible, altho my idea may not be as direct a connection as
you'd like.

Outlook PST files are essentially large database files. Each email is
a record, and within that record are fields that contain the data: To,
From, Subject, Date Sent, Date Received, etc. You could use MS Access
to link to the PST file and extract the Subject format, then export
that to Excel. Once it is set up it can be done quickly.

Would something like that be do-able for you?

DaveO
Eschew obfuscation

 

[Steve Yandl]

Is the folder with the emails a subfolder of your inbox or a folder at the
same level as the inbox?

Do you want to look at every email in that folder every time you run the
subroutine or do you want to filter by some criteria like date received or
sender name?


Steve

 

[juanpablo]

Its a subfolder at inbox.
It would be good to filter for date received.

JP

 

[Steve Yandl]

This should get you started.

For the example, I used a subfolder of my inbox named "Jokes". In the
example, I write the entire subject lines from messages in the \Inbox\Jokes
folder to cells in column "A:A" of worksheet. I didn't know what format
your subject line had so I could not extend the example to show how to
manipulate the text string used as subject line.

___________________________________

Sub FetchSubjectLines()

Const olFldrInbox = 6

Dim R As Integer

' Determine row of first available cell in "A:A"
R = Range("A65536").End(xlUp).Row + 1

'Get folder object for subfolder of inbox
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFldrInbox)
Set myFldr = objFolder.Folders("Jokes")

'Grab subject lines from messages in jokes folder less than three days old
For Each msgItem In myFldr.Items
If DateDiff("d", msgItem.ReceivedTime, Now) < 3 Then
Cells(R, 1).Value = msgItem.Subject
R = R + 1
End If
Next msgItem

Set objNS = Nothing
Set objOL = Nothing

End Sub

__________________________________

Steve Yandl

 

[juanpablo]

Awesome.

It worked perfect, thank you so much!

JPG

 

[juanpablo]

Awesome.

It worked perfect, thank you so much!

If I have this Subject:

POSITIVE FS / SCL-JFK / LA 530 / 01DEC07 / 1100 kgs. / 045- 55950392

Can I use the same macro and insert all the information but each "/" use it
as separator for each column?

JPG

 

[Steve Yandl]

Sub FetchSubjectLines()

Const olFldrInbox = 6

Dim R As Integer

' Determine row of first available cell in "A:A"
R = Range("A65536").End(xlUp).Row + 1

'Get folder object for subfolder of inbox
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFldrInbox)
Set myFldr = objFolder.Folders("Jokes")

'Grab subject lines from messages in jokes folder less than three days old
For Each msgItem In myFldr.Items
If DateDiff("d", msgItem.ReceivedTime, Now) < 3 Then
If InStr(msgItem.Subject, "/") > 1 Then
subArray = Split(msgItem.Subject, "/")
For s = 0 To UBound(subArray)
Cells(R, s + 1).Value = subArray(s)
Next s
R = R + 1
End If
End If
Next msgItem

Set objNS = Nothing
Set objOL = Nothing

End Sub



Steve Yandl

 

[juanpablo]

Absolutely amazing, I want to learn how to program like you do!!!

JPG

 

[Steve Yandl]

There is one change you might want to make but I didn't want to make any
assumptions. There were blank spaces surrounding each of the forward
slashes and those spaces are retained. If you want to clean up the text in
each cell, just change the line that reads:
Cells(R, s + 1).Value = subArray(s)
to
Cells(R, s + 1).Value = Trim(subArray(s))


Steve Yandl

 

[juanpablo]

Is it also possible to add a column with the senders name or email?

JPG

 

[Steve Yandl]

The modified subroutine below will parse your subject line and also populate
columns with the sender's name and sender's email address. However, because
of security, when you run the routine you will get a pop-up box alerting you
that a program is attempting to extract address information and you will
need to approve this action for a selectable time period.

______________________________________________

Sub FetchSubjectLines()

Const olFldrInbox = 6

Dim R As Integer

' Determine row of first available cell in "A:A"
R = Range("A65536").End(xlUp).Row + 1

'Get folder object for subfolder of inbox
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFldrInbox)
Set myFldr = objFolder.Folders("Jokes")

'Grab subject lines from messages in jokes folder less than three days old
For Each msgItem In myFldr.Items
If DateDiff("d", msgItem.ReceivedTime, Now) < 5 Then
If InStr(msgItem.Subject, "/") > 1 Then
subArray = Split(msgItem.Subject, "/")
For s = 0 To UBound(subArray)
Cells(R, s + 1).Value = Trim(subArray(s))
Next s
Cells(R, s + 1).Value = msgItem.SenderEmailAddress
Cells(R, s + 2).Value = msgItem.SenderName
R = R + 1
End If
End If
Next msgItem

Set objNS = Nothing
Set objOL = Nothing

End Sub

______________________________________________

Steve

 

[Excel Help!]

Steve,

I can collect the msgItem.Subject and msgItem.EmailAddress. However, I
can't locate the proper name for the email date: msgItem.? Can you help?
Thanks