使用带有Excel VBA的交换服务器从Outlook 2013导入电子邮件

Question

将电子邮件从 Outlook 2013 导入到 Excel 2013 适用于家庭桌面。Outlook 2013 已连接到 SMTP/POP 服务器。

同样的代码在我的办公室不起作用。Outlook 2013 已连接到 Exchange 服务器。

处出错。发件人电子邮件地址

Option Explicit
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/26/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
            'Getting debug error here as not supported.
            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

Answer 1

交叉发布很好，但总是提到两个线程中的链接。

在2013版本中将Outlook电子邮件导入Excel。

刚刚使用连接到Exchange Server的Excel/Outlook2013进行了测试，并且没有复制该问题。

您是否在第一封电子邮件或特定电子邮件中收到错误？

但是，请检查以下更改。

Function Get_Sender_Address(oMsg As Outlook.MailItem) As String
Dim oExUser As Outlook.ExchangeUser, oAddType As Outlook.AddressEntry
Set oAddType = oMsg.Sender
If oAddType.AddressEntryUserType = olExchangeUserAddressEntry Then
    Set oExUser = oAddType.GetExchangeUser
        Get_Sender_Address = oExUser.PrimarySmtpAddress
Else
    Get_Sender_Address = oMsg.SenderEmailAddress
End If
Set oAddType = Nothing:    Set oExUser = Nothing
End Function

&

Cells(n, 3) = Get_Sender_Address(olMail) 'olMail.SenderEmailAddress