How to troubleshoot runtime error: Class doesn't support Automation (Error 430)

Question

以下子例程在将新项目添加到指定的 Outlook 项目集合（在本例中为 Outlook 邮件文件夹）时运行。子检查该项目是否是邮件项目，然后检查电子邮件地址是否来自交换服务器。

指定 .sendemailtype 属性时代码会抛出错误，但我不知道为什么或如何解决它。

Private Sub olItems_ItemAdd(ByVal Item As Object)

Dim my_olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Dim SMTPAddress As String
Dim olAttFilter As String
Dim fso As Object


Set fso = CreateObject("Scripting.FileSystemObject")

If TypeName(Item) = "MailItem" Then
    
    Set my_olMail = Item
        
        
        If my_olMail.SenderEmailType = "EX" Then
                SMTPAddress = my_olMail.Sender.GetExchangeUser.PrimarySmtpAddress
        Else
            'must be SMTP address if not EX
            SMTPAddress = my_olMail.SenderEmailAddress
        End If
End Sub

谢谢！

出现的错误： https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/class-doesn-t-support-automation-error-430

Answer 1

Sender相关的设置仅针对已发送的项目。因此，您需要检查 Sender 属性是否不是 Nothing（在 C# 中为 null），然后才尝试识别发件人类型：

Private Sub Application_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean) Handles application.ItemSend

    Dim mailItem As Outlook.MailItem = DirectCast(Item, Outlook.MailItem)

    Dim sender As Outlook.AddressEntry = mailItem.Sender
    Dim senderAddress As String = ""

    If sender IsNot Nothing AndAlso
       (sender.AddressEntryUserType = Outlook.OlAddressEntryUserType.olExchangeAgentAddressEntry OrElse _
        sender.AddressEntryUserType = Outlook.OlAddressEntryUserType.olExchangeRemoteUserAddressEntry) Then
        Dim exchangeUser As Outlook.ExchangeUser = sender.GetExchangeUser()

        If exchangeUser IsNot Nothing Then
            senderAddress = exchangeUser.PrimarySmtpAddress()
        End If
    Else
        Dim recipient As Outlook.Recipient = application.Session.CreateRecipient(mailItem.SenderEmailAddress)
        If recipient IsNot Nothing Then
            Dim exchangeUser As Outlook.ExchangeUser = recipient.AddressEntry.GetExchangeUser()
            If exchangeUser IsNot Nothing Then
                senderAddress = exchangeUser.PrimarySmtpAddress()
            End If
        End If

        'check if senderAddress has been set with above code. If not try SenderEmailAddress
        If senderAddress = "" Then
            senderAddress = mailItem.SenderEmailAddress()
        End If
    End If

    MessageBox.Show(senderAddress)

End Sub

有关详细信息，请参阅。

How to troubleshoot runtime error: Class doesn't support Automation (Error 430)

How to troubleshoot runtime error: Class doesn't support Automation (Error 430)

outlook

vba