VBA CODE TO EXTRACT EMAIL FROM MS OUTLOOK 2010

[Reetesh]

Hello I'm Trying to extract email from outlook 2010 in an excel file.

Below is the code which I got for it:

Sub GetMailInfo()
Dim results() As String
results = ExportEmails(True)
Range(Cells(1, 1), Cells(UBound(results), UBound(results, 2))).Value = results
MsgBox "Completed"
End Sub

Function ExportEmails(Optional headerRow As Boolean = False) As String()
Dim objOutlook As Object
Dim objNamespace As Object
Dim strFolderName As Object
Dim objMailbox As Object
Dim objFolder As Object
Dim mailFolderItems As Object
Dim folderItem As Object
Dim msg As Object
Dim tempString() As String
Dim i As Long
Dim numRows As Long
Dim startRow As Long
Dim jAttach As Long
Dim debugMsg As Integer

Sheets("Outlook Results").Select
Sheets("Outlook Results").Cells.ClearContents
Range("A1").Select

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set strFolderName = objNamespace.PickFolder
Set mailFolderItems = strFolderName.Items

If headerRow Then
startRow = 1
Else
startRow = 0
End If

numRows = mailFolderItems.Count

ReDim tempString(1 To (numRows + startRow), 1 To 100)

For i = 1 To numRows
Set folderItem = mailFolderItems.Item(i)

If IsMail(folderItem) Then
Set msg = folderItem
End If

With msg

tempString(i + startRow, 1) = .SenderName
tempString(i + startRow, 2) = .SentOn
tempString(i + startRow, 3) = .ReceivedTime
tempString(i + startRow, 4) = .Subject
tempString(i + startRow, 5) = Left$(.Body, 900) ' throws error without limit
tempString(i + startRow, 6) = .To
tempString(i + startRow, 7) = .cc
tempString(i + startRow, 8) = .SenderEmailAddress
tempString(i + startRow, 9) = .SenderEmailType

End With

If msg.Attachments.Count > 0 Then

For jAttach = 1 To msg.Attachments.Count
tempString(i + startRow, 39 + jAttach) = msg.Attachments.Item(jAttach).DisplayName
Next jAttach

End If

Next i

If headerRow Then

tempString(1, 1) = "Sender Name"
tempString(1, 2) = "Sent On"
tempString(1, 3) = "Received Time"
tempString(1, 4) = "Subject"
tempString(1, 5) = "Body"
tempString(1, 6) = "Sent To"
tempString(1, 7) = "CC"
tempString(1, 8) = "Sender Email Address"
tempString(1, 9) = "Sender Email Type"

End If

ExportEmails = tempString

Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
'Selection.AutoFilter

End Function

Function IsMail(itm As Object) As Boolean
IsMail = (TypeName(itm) = "MailItem")
End Function

However, in the above code when i run it, it gives a "Run-time error '91': Object variable or With block variable not set", when the code tries to execute this "tempString(i + startRow, 1) = .SenderName" command.

Not sure what exactly needs to be done to fix this.
Thought of asking all the experts here

Any help is appreciated.
Thanks is advance.

 

[Reetesh]

Hello Domenic.
Sorry for the delay in response mate.
Was caught up with some work.
The code which you sent worked fine.
It was my mistake and i was not copy and pasting it properly.

Thanks again for you help mate. Appreciated

 

[Domenic]

That's great, I'm glad you were able to sort it out.

And thanks for letting me know.

Cheers!