Solved: Importing Email from Outlook to Excel

[Skopweb]

Hello All
I have the following macros that helps me import outlook emails to an excel sheet. However there are few problems that i face.
1. When i try to pull emails from a folder in outlook that has too many emails (like 500+), it begins with 10-15 mails and then stop giving an error saying
"Type Mismatch".
This doesnt not happen with a folder that has less than 100 mails and it works absolutely fine.
2. I would like to know if i need to pull emails with specific criteria (eg: received dates between date A and date B), is it possible? If yes, what are the changes?

Option Explicit
Dim n As Long
Sub Launch_Pad()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

n = 2
Cells.ClearContents

Call ProcessFolder(olFolder)

Set olNS = Nothing
Set olFolder = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub


Sub ProcessFolder(olfdStart As Outlook.MAPIFolder)

Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olMail As Outlook.MailItem

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then
n = n + 1
Set olMail = olObject
Cells(n, 1) = olMail.Subject
If Not olMail.UnRead Then
Cells(n, 2) = "Message is read"
Cells(n, 3) = olMail.ReceivedTime
Cells(n, 4) = olMail.LastModificationTime
Cells(n, 5) = olMail.Categories
Cells(n, 6) = olMail.SenderName
Cells(n, 7) = olMail.FlagRequest
Else
Cells(n, 2) = "Message is unread"
Cells(n, 3) = olMail.ReceivedTime
Cells(n, 4) = olMail.LastModificationTime
Cells(n, 5) = olMail.Categories
Cells(n, 6) = olMail.SenderName
Cells(n, 7) = olMail.FlagRequest
End If
End If
Next


Set olMail = Nothing
Set olFolder = Nothing
Set olObject = Nothing
End Sub


Regards
Skopweb

[p45cal]

What line gives the type mismatch error?

[Skopweb]

No number or line .... just Type Mismatch and have the option to click OK or help.

Do u know if i can pull out email received within specific dates?
Regards
Skopweb

[p45cal]

No number or line .... just Type Mismatch and have the option to click OK or help.

Do u know if i can pull out email received within specific dates?
Regards
Skopweb

No Debug button?!

[Skopweb]

No.... nothing at all.

[p45cal]

Aha!
I faintly remember coming across something like this before - it turned out to be a misleading error message and what was needed was a freeing up of memory or something like that. I can't remember exactly what was required, perhaps it was something like emptying the recycle bin - I can't quite remember. I'll rack my brains a bit more. BTW it works well here on a folder with more than 16000 mail items.
Regarding dates:
Sub ProcessFolder(olfdStart As Outlook.MAPIFolder)
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olMail As Outlook.MailItem
Dim Date1, Date2

Date1 = CDate("1-Jan-2009")
Date2 = CDate("21-Jan-2009")

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then
Application.StatusBar = olObject.ReceivedTime
'If olObject.SentOn >= Date1 And olObject.SentOn <= Date2 Then
If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
n = n + 1
Set olMail = olObject
Cells(n, 1) = olMail.Subject
If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
Cells(n, 3) = olMail.ReceivedTime
Cells(n, 4) = olMail.LastModificationTime
Cells(n, 5) = olMail.Categories
Cells(n, 6) = olMail.SenderName
Cells(n, 7) = olMail.FlagRequest
End If
End If
Next
Set olMail = Nothing
Set olFolder = Nothing
Set olObject = Nothing
End Sub
I've put an alternative (commented-out) line relying on the date an email was sent rather than when it was received, if that's any use.
Of course you could ask for the dates to be input in LaunchPad and pass these to ProcessFolder as arguments.

I tried googling for:excel vba type mismatch memory,
these links might be some use:
http://www.mrexcel.com/forum/showthread.php?t=402346
http://support.microsoft.com/kb/177991
http://support.microsoft.com/kb/186063
but there were lots more.

[Skopweb]

This works for the dates, i have not tried for the first problem. Let me too look out for the reason for the error.
BTW
If i need to make something like as soon as i run the macros it should ask me for the dates, then how would it be.
Is it possible to refer the CDate to a cell in the sheet where i will have my dates entered

Regards
Skopweb

[p45cal]

Hey Pal
This works for the dates, i have not tried for the first problem. Let me too look out for the reason for the error.
BTW
If i need to make something like as soon as i run the macros it should ask me for the dates, then how would it be.
Is it possible to refer the CDate to a cell in the sheet where i will have my dates entered

Regards
Skopweb
Neither 'Hey' nor 'Pal' are terms that work for me.

Adjust the 'J1' and 'K1' cell references in these lines to suit (they're only the defaults, they can be altered when running by selecting other cells, or you can enter a date directly in the input box):
Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", "=J1", , , , , 10)
Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", "=K1", , , , , 10)

Option Explicit
Dim n As Long
Sub Launch_Pad()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1, Date2

Do
'Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", , , , , , 10)
Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", "=J1", , , , , 10)
If Date1 = False Then Exit Sub
On Error Resume Next
Date1 = CDate(Date1)
On Error GoTo 0
Loop Until IsDate(Date1)
Do
'Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", , , , , , 10)
Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", "=K1", , , , , 10)
If Date2 = False Then Exit Sub
On Error Resume Next
Date2 = CDate(Date2)
On Error GoTo 0
Loop Until IsDate(Date2)
'MsgBox Format(Date1, "dd mmm yyyy") & ", " & Format(Date2, "dd mmm yyyy")

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

n = 2
Cells.ClearContents 'if there are start/end dates in any cell on this sheet this command will erase them

Call ProcessFolder(olFolder, Date1, Date2)

Set olNS = Nothing
Set olFolder = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub
Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, Date1, Date2)
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olMail As Outlook.MailItem

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then
'Application.StatusBar = olObject.ReceivedTime
'If olObject.SentOn >= Date1 And olObject.SentOn <= Date2 Then
If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
n = n + 1
Set olMail = olObject
Cells(n, 1) = olMail.Subject
If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
Cells(n, 3) = olMail.ReceivedTime
Cells(n, 4) = olMail.LastModificationTime
Cells(n, 5) = olMail.Categories
Cells(n, 6) = olMail.SenderName
Cells(n, 7) = olMail.FlagRequest
End If
End If
Next
Set olMail = Nothing
Set olFolder = Nothing
Set olObject = Nothing
End Sub

[Skopweb]

Hello p45cal
Sorry for the "Hey" and "pal".
The code works absolutely fine.
Thanks a ton for the help
Regards
Skopweb

[sravanmonty]

Hello Experts.

This code works perfectly at home pc as outlook connected to SMPT/POP...but the same code does not work at office where outlook is connected to exchange server...any clue.

Error at : Cells(n, 6) = olMail.SenderName