使用帶有 Excel VBA 的 Exchange 服務器從 Outlook 2013 導入電子郵件

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

交叉發布很好，但總是提到兩個線程中的鏈接。

在 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