Solved: Syntax Rectification Required

Below code will extract data from Outlook to Excel, its working fine, I need to alter this code to extract only current + last 5 days data from outlook.

in other words, there should be message box which displays the date criteria "From Date" and "To Date" to extract the details from Outlook

And also each line data should show from which folder the data has been extracted (if it extracted from "Inbox", "Sent Items")

kindly help me in this regard

[vba]
Sub Inb()

Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long

'Get/create Outlook Application
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olNS = appOutlook.GetNamespace("MAPI")

'Change value if you want another folder:
Set olFolder = olNS.Folders(("Mailbox - Satish Gubbi ")).Folders("Inbox")
Cells.Delete

r = 1
'Build headings:
Range("A1:C1") = Array("ReceivedFrom", "Subject", "ReceivedTime")

For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
r = r + 1
Cells(r, "A") = olItem.SenderEmailAddress
Cells(r, "B") = olItem.Subject
Cells(r, "C") = olItem.SentOn
End If
Next olItem
Columns.AutoFit

End Sub
[/vba]

Trying changing/adding to part of your code:
[vba]'Build headings:
Range("A1:C1") = Array("ReceivedFrom", "Subject", "ReceivedTime")
FiveDaysAgo = Now - 5 'note it's now - 5*24 hours, not any time since midnight on a date 5 days ago.
For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
If olItem.ReceivedTime > FiveDaysAgo Then
r = r + 1
Cells(r, "A") = olItem.SenderEmailAddress
Cells(r, "B") = olItem.Subject
Cells(r, "C") = olItem.SentOn
End If
End If
Next olItem
[/vba]Note that
1. your code only looks in the Inbox, so all messages are from there
2. your third header is Received time but actually shows Sent time
3. I've used ReceivedTime to decide which mail items to show

Hi p45cal,

Thank you very much for helping me in this, I will check this code and post the results.

and at the same time can we have column which shows from which folder the data has been retrieved.

And by adding the foldernames like below, is this still retrieve the data?

[VBA]
.Folders("Inbox", "Sent_Items","Personal")
[/VBA]

kindly help me

see:
http://www.ozgrid.com/forum/showthread.php?t=93067

http://www.ozgrid.com/forum/showthread.php?t=26435

http://www.ozgrid.com/forum/showthread.php?t=30346

Combining some code from the above links with the snippet I provided should get you what you need.

Hi p45cal,

Thank you very much for the reply,
I will try to combine and see whether this works out, and post the result

Satish Gubbi

Hi p45cal,

I tried to do it, but I was getting compile error, request you to help me with the last query

Regards,
Satish Gubbi

Quote:

---

Originally Posted by satish gubbi

Hi p45cal,

I tried to do it, but I was getting compile error, request you to help me with the last query

Regards,
Satish Gubbi

---

Show your code.

here is the code that I am trying to work out, request your help in this

[VBA]
Sub GETDATA()

Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long

'Get/create Outlook Application
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error Goto 0

Set olNS = appOutlook.GetNamespace("MAPI")

'Change value if you want another folder:
Set olFolder = olNS.Folders(("Mailbox - Satish Gubbi ")).Folders("Inbox","Sent Items","PRIME","Leased")
Cells.Delete

r = 1
'Build headings:
Range("A1:D1") = Array("FoundIn","RcdFrom/SentBy", "Subject", "Time")
FiveDaysAgo = Now - 5 'note it's now - 5*24 hours, not any time since midnight on a date 5 days ago.
For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
If olItem.ReceivedTime > FiveDaysAgo Then
r = r + 1

Cells(r, "A") = olItem.FolderName
Cells(r, "B") = olItem.SenderName
Cells(r, "C") = olItem.Subject
Cells(r, "D") = olItem.SentOn
End If
End If
Next olItem
Columns.AutoFit

End Sub

[/VBA]

Have you even looked at the links I gave? There is no evidence of this.

Hi P45cal,

below is the code that I am working by using web links provided by you

however I need to alter this code retreive only last five days data including current data and also I need to mention the email accounts that this code to look in (as of now it pull all mailboxes, which is not required)and this should download only Inbox and Sent Items not any other folders

kindly help me

[VBA]

' Requires reference to Outlook library
'
Public Sub ListOutlookFolders()

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim rngOutput As Range
Dim lngCol As Long
Dim olItem As Outlook.MailItem

Set rngOutput = ActiveSheet.Range("A1")

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

For Each olFolder In olNamespace.Folders
rngOutput = olFolder.Name
rngOutput.Offset(0, 1) = olFolder.Description
Set rngOutput = rngOutput.Offset(1)
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
Set rngOutput = rngOutput.Offset(1)
With rngOutput
.Offset(0, 1) = olItem.SenderName ' Sender
.Offset(0, 2) = olItem.Subject ' Subject
.Offset(0, 3) = olItem.ReceivedTime ' Received
.Offset(0, 4) = olItem.ReceivedByName ' Recepient
.Offset(0, 5) = olItem.UnRead ' Unread?
.Offset(0, 6) = olItem.ReplyRecipientNames '
.Offset(0, 7) = olItem.SentOn
End With
End If
Next

Set rngOutput = ListFolders(olFolder, 1, rngOutput)
Next

Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing

End Sub
Function ListFolders(myFolder As Outlook.MAPIFolder, Level As Integer, Output As Range) As Range
'
'
'
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Outlook.MailItem
Dim lngCol As Long

For Each olFolder In myFolder.Folders
lngCol = ((Level - 1) * 8) + 1
Output.Offset(0, lngCol) = olFolder.Name
Set Output = Output.Offset(1)
If olFolder.DefaultItemType = olMailItem Then
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
With Output
.Offset(0, lngCol + 1) = olItem.SenderName ' Sender
.Offset(0, lngCol + 2) = olItem.Subject ' Subject
.Offset(0, lngCol + 3) = olItem.ReceivedTime ' Received
.Offset(0, lngCol + 4) = olItem.ReceivedByName ' Recepient
.Offset(0, lngCol + 5) = olItem.UnRead ' Unread?
.Offset(0, lngCol + 6) = olItem.ReplyRecipientNames '
.Offset(0, lngCol + 7) = olItem.SentOn

End With
Set Output = Output.Offset(1)
End If
Next
End If
If olFolder.Folders.Count > 0 Then
Set Output = ListFolders(olFolder, Level + 1, Output)
End If
Next
Set ListFolders = Output.Offset(1)

End Function
[/VBA]

and the below code is working fine, however this will pull only one folder at a time (although modified) can this be modified to pull two or three folders at a time

Kindly help me to get this code working

[VBA]
Sub Inb_GBDFSU()

Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long

'Get/create Outlook Application
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olNS = appOutlook.GetNamespace("MAPI")

'Change value if you want another folder:
Set olFolder = olNS.Folders(("Mailbox - Satish gubbi")).Folders("Inbox")
Set olFolder = olNS.Folders(("Mailbox - Satish Gubbi")).Folders("Sent Items")

Cells.Delete

r = 1
'Build headings:
Range("A1:D1") = Array("FoundIn", "RecdFrom/sentBy", "Subject", "Recd/SentTime")
FiveDaysAgo = Now - 1 'note it's now - 5*24 hours, not any time since midnight on a date 5 days ago.

For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
If olItem.ReceivedTime > FiveDaysAgo Then
r = r + 1
Cells(r, "A") = olFolder.Name
Cells(r, "B") = olItem.SenderName
Cells(r, "C") = olItem.Subject
Cells(r, "D") = olItem.SentOn
End If
End If
Next olItem
Columns.AutoFit

End Sub
[/VBA]

That's better.
Try (not sure about the depth of nesting of your folders in the Outlook folder tree):
[VBA]Sub Inb_GBDFSU()
Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long

'Get/create Outlook Application
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olNS = appOutlook.GetNamespace("MAPI")
Cells.Delete
r = 1
'Build headings:
Range("A1:D1") = Array("FoundIn", "RecdFrom/sentBy", "Subject", "Recd/SentTime")
FiveDaysAgo = Now - 1 'note it's now - 5*24 hours, not any time since midnight on a date 5 days ago.
'Change value if you want another folder:

Dim myFolders(1 To 4)
Set myFolders(1) = olNS.Folders("Mailbox - Satish gubbi").Folders("Inbox")
Set myFolders(2) = olNS.Folders("Mailbox - Satish gubbi").Folders("Sent Items")
Set myFolders(3) = olNS.Folders("Mailbox - Satish gubbi").Folders("Leased")
Set myFolders(4) = olNS.Folders("Mailbox - Satish gubbi").Folders("PRIME")

For Each item In myFolders
Set olFolder = item
For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
If olItem.ReceivedTime > FiveDaysAgo Then
r = r + 1
Cells(r, "A") = olFolder.Name
Cells(r, "B") = olItem.SenderName
Cells(r, "C") = olItem.Subject
Cells(r, "D") = olItem.SentOn
End If
End If
Next olItem
Next item
Columns.AutoFit
End Sub
[/VBA]

Thank you very much p45cal, its working fine, one last request, can I have below code to show the mailbox name from where its been retreived

I am getting an run time error 438
Object doesnot support this property or method

[VBA]
Cells(r, "A") = olNS.FoldersName
[/VBA]

it should show mail box name "Mailbox - Satish Gubbi"

Kindly help in this regard

olNS.Folders("Mailbox - Satish gubbi").name
or more than likely:
olNS.Folders(1).name
but since you've hard coded this why not just use:
"Mailbox - Satish gubbi"

hi P45cal
Thank you very much for all your support, its working fine..........

I tried to map subfolders to get the data but unsucessful, mean to say folder under Inbox, but its not extracting can you please help

[VBA]
Set myFolders(4) = olNS.Folders("Mailbox - Satish gubbi").Folders("PRIME")
[/VBA]
Prime is a subfolder under Inbox

kindly help

[VBA]Set myFolders(4) = olNS.Folders("Mailbox - Satish gubbi").Folders("Inbox").Folders("PRIME")
[/VBA]

Hi p45cal,

Thank you very much for all your help. its working as required

can we add this working code to kb database, so that it can be used anyone who has the requirement

Regards,
Satish Gubbi

Quote:

---

Originally Posted by satish gubbi

Hi p45cal,

Thank you very much for all your help. its working as required

can we add this working code to kb database, so that it can be used anyone who has the requirement

Regards,
Satish Gubbi

---

Thanks for the feedback, but I don't think it's flexible enough for that.