PDA

View Full Version : Read outlook emails copy to excel.



sravanmonty
01-21-2017, 01:24 PM
Hello Experts.

Required urgent help

Attached the working file which is working great at home pc as outlook 2013 and server is SMPT/POP...and the same code not working in office as outlook 2013 is on exchange server..

Not really sure how different if outlook 2013 is connect to Exchange server and outlook 2013 is connected to SMPT/POP...if so help me in modifing the code.

Hope am not confusing...Please let me know if you have any questions..

TheSilkCode
01-21-2017, 01:31 PM
Could you please paste the code so we can see it?

sravanmonty
01-21-2017, 01:36 PM
Here is the code...Please do needful


Option ExplicitDim n As Long
Sub Get_data()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1, Date2
Date1 = "01/20/2017"


Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder
n = 2
Call Get_Emails(olFolder, Date1)

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

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then

If olObject.ReceivedTime <= Date1 Then
n = n + 1
Set olMail = olObject
'Sno
Cells(n, 1) = n
'Universal id
Cells(n, 2) = olMail.ConversationID
'Email id
Cells(n, 3) = olMail.SenderEmailAddress

'Date and time workings
Cells(n, 4) = olMail.ReceivedTime

'Size
Cells(n, 6) = olMail.Size

'Subject
Cells(n, 7) = olMail.Subject

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

sravanmonty
01-21-2017, 01:38 PM
Hello

As discussed , which is working great at home pc as outlook 2013 and server is SMPT/POP...and the same code not working in office as outlook 2013 is on exchange server. Not really sure is that the problem.

Error at :Cells(n, 3) = olMail.SenderEmailAddress

sravanmonty
01-22-2017, 11:35 AM
Guys

Any update on my query!!

Kenneth Hobs
01-22-2017, 03:05 PM
Make sure that outlook is open when you run it.

sravanmonty
01-23-2017, 12:03 PM
Hello Kenneth Hobs...

Thanks for your quick response..Outlook is opened when running macro.

As discussed , which is working great at home pc as outlook 2013 and server is SMPT/POP...and the same code not working in office as outlook 2013 is on exchange server. Not really sure is that the problem.

Error at :Cells(n, 3) = olMail.SenderEmailAddress

Please help..

Kenneth Hobs
01-23-2017, 02:57 PM
Have you tried:

Debug.Print Cells(n, 3)
Debug.Print olMail.SenderEmailAddress
Check VBE's Immediate window after a run to see the result of Debug.Print.

Since I don't use Exchange anymore, I have no way to test.

Some of these concepts might help:
'http://forums.codeguru.com/showthread.php?441008-Extract-sender-s-email-address-from-an-Exchange-email

Private Function GetSmtpAddress(ByVal item As Outlook.MailItem) As StringDim sAddress As String
Dim recip As Outlook.Recipient
Dim exUser As Outlook.ExchangeUser
Dim oOutlook As Outlook.Application
Dim oNS As Outlook.Namespace


Set oOutlook = New Outlook.Application
Set oNS = oOutlook.GetNamespace("MAPI")
If UCase$(item.SenderEmailType) = "EX" Then
Set recip = oNS.CreateRecipient(item.SenderEmailAddress)
Set exUser = recip.AddressEntry.GetExchangeUser()
sAddress = exUser.PrimarySmtpAddress
Else
sAddress = item.SenderEmailAddress
End If
GetSmtpAddress = sAddress
Set oNS = Nothing
Set oOutlook = Nothing
End Function
or
https://www.experts-exchange.com/questions/28169495/Different-ways-of-retrieving-the-sender-of-an-email-in-Outlook-VBA.html

Kenneth Hobs
01-24-2017, 06:18 PM
PM's that relate to a thread should be contained in that thread. I don't know how to help more other than post 8. It is up to you to try the Debug.Print troubleshooting as I said. Paste the results of the Immediate window after a run if it makes no sense.


Dim n As Long

Sub Get_data()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1, Date2
Date1 = "01/20/2017"


Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder
n = 2
Call Get_Emails(olFolder, Date1)

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


Sub Get_Emails(olfdStart As Outlook.MAPIFolder, Date1)
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olMail As Outlook.MailItem
Dim Recivedt As Date

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then

If olObject.ReceivedTime <= Date1 Then
n = n + 1
Set olMail = olObject
'Sno
Cells(n, 1) = n
'Universal id
Cells(n, 2) = olMail.ConversationID
'Email id

Debug.Print GetSmtpAddress(olObject), "GetSmtpAddress"
Debug.Print Cells(n, 3).Value, "Cells(n, 3).value"
Debug.Print olMail.SenderEmailAddress, "olMail.SenderEmailAddress"

Cells(n, 3) = olMail.SenderEmailAddress

'Date and time workings
Cells(n, 4) = olMail.ReceivedTime

'Size
Cells(n, 6) = olMail.Size

'Subject
Cells(n, 7) = olMail.Subject

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


'http://forums.codeguru.com/showthread.php?441008-Extract-sender-s-email-address-from-an-Exchange-email
Private Function GetSmtpAddress(ByVal item As Outlook.MailItem) As String
Dim sAddress As String
Dim recip As Outlook.Recipient
Dim exUser As Outlook.ExchangeUser
Dim oOutlook As Outlook.Application
Dim oNS As Outlook.Namespace


Set oOutlook = New Outlook.Application
Set oNS = oOutlook.GetNamespace("MAPI")
If UCase$(item.SenderEmailType) = "EX" Then
Set recip = oNS.CreateRecipient(item.SenderEmailAddress)
Set exUser = recip.AddressEntry.GetExchangeUser()
sAddress = exUser.PrimarySmtpAddress
Else
sAddress = item.SenderEmailAddress
End If
GetSmtpAddress = sAddress
Set oNS = Nothing
Set oOutlook = Nothing
End Function

sravanmonty
01-26-2017, 01:59 PM
Still no luck Kenneth...Please help


Error : Not Supported.

Debug.Print GetSmtpAddress(olObject), "GetSmtpAddress"
Debug.Print Cells(n, 3).Value, "Cells(n, 3).value"
Debug.Print olMail.SenderEmailAddress, "olMail.SenderEmailAddress"