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" wrote in message
...
Absolutely amazing, I want to learn how to program like you do!!!

JPG

"Steve Yandl" wrote:

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" wrote in message
...
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?