Solved: Syntax Rectification Required

[satish gubbi]

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


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

[p45cal]

Trying changing/adding to part of your code:
'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
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

[satish gubbi]

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?


.Folders("Inbox", "Sent_Items","Personal")


kindly help me

[p45cal]

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.

[satish gubbi]

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

[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

[p45cal]

Hi p45cal,

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

Regards,
Satish GubbiShow your code.

[satish gubbi]

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


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

[p45cal]

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

[satish gubbi]

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



' 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

[satish gubbi]

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


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

[p45cal]

That's better.
Try (not sure about the depth of nesting of your folders in the Outlook folder tree):
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

[satish gubbi]

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


Cells(r, "A") = olNS.FoldersName


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

Kindly help in this regard

[p45cal]

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"

[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


Set myFolders(4) = olNS.Folders("Mailbox - Satish gubbi").Folders("PRIME")

Prime is a subfolder under Inbox

kindly help

[p45cal]

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

[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

[p45cal]

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 GubbiThanks for the feedback, but I don't think it's flexible enough for that.