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

The below subroutine runs when a new item is added to a specified collection of Outlook Items (in this case, an Outlook mail folder). The sub checks whether the item is mail item and then checks whether the email address is from an exchange server.

The code throws an error when the .sendemailtype property is specified, although I can't figure out why or how to work around it.

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

Thanks!

The error that appears: https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/class-doesn-t-support-automation-error-430

CodePudding user response：

The Sender-related are set on sent items only. So, you need to check whether the Sender property is not Nothing (null in C#) and only after that try to recognize the sender type:

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

See Check if Outlook SenderEmailType is exchange and set variable for more information.