Question

将Outlook 2013中的电子邮件导入Excel 2013可与家用桌面配合使用。 Outlook 2013已连接到SMTP / POP服务器。

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

.Senderemailaddress错误

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

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

Importing outlook emails to excel in 2013 version.

刚刚使用Excel / Outlook2013连接到Exchange Server＆amp;没有复制这个问题。

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

但请检查以下更改。

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

使用Exchange VBA从Outlook 2013导入电子邮件

1 个答案: