从 Excel 发送邮件 - 运行时错误“429”：ActiveX 组件无法创建对象

Question

I have to rewrite code which works on Win but doesn't on Mac.

When I run the code I got error:

Run-time error '429': ActiveX component can't create object

at line: Set iMsg = CreateObject("CDO.Message") .

I already Google thru Internet.

Dim msgbox1
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim xRange As Range
Dim xCell As Long
Dim xCount As Long
Dim i As Long

' First run the checks that all needed info is there
' before we display the form

If frmEmail.fldSubject.TextLength < 5 Then
    MsgBox "Please fill in a subject for the email", vbExclamation
    Exit Sub
End If

If frmEmail.fldEmailBox.TextLength < 5 Then
    MsgBox "Please put some information in the email body", vbExclamation
    Exit Sub
End If

msgbox1 = MsgBox("Are you sure you want to email all selected users in this Directorate: " & _
vbCrLf & vbCrLf & Worksheets("Contact Info").Cells(12, 4), vbOKCancel + vbExclamation, "Attention! Attention!! Attention!!!")

If msgbox1 = vbOK Then
    msgbox1 = MsgBox("Are you sure you want to email all users using the following SMTP server: " & _
    vbCrLf & vbCrLf & Worksheets("ADMIN").Cells(25, 3), vbOKCancel + vbExclamation, "Attention! Attention!! Attention!!!")

    If msgbox1 = vbOK Then
        Rem msgbox1 = MsgBox("Place holder for email function")
        'Here we go with emailing
        Sheets("Users Details Form").Activate
        Set iMsg = CreateObject("CDO.Message")
        Set iConf = CreateObject("CDO.Configuration")

        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Trim(Worksheets("ADMIN").Range("c24").Value)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

        Set xRange = Worksheets("Users Details Form").Range("A1:A65536")
        xCount = Application.CountIf(xRange, "x")

        For i = 1 To xCount
            strbody = frmEmail.fldEmailBox.Text
            xCell = xRange.Find("x").Row

            strbody = Replace(strbody, "%%user%%", Range("B" & xCell) & " " & Range("C" & xCell))
            strbody = Replace(strbody, "%%username%%", Range("F" & xCell))
            strbody = Replace(strbody, "%%password%%", Range("G" & xCell))
            strbody = Replace(strbody, "%%role%%", Range("H" & xCell))

            On Error Resume Next
            With iMsg
                Set .Configuration = iConf
                .To = Range("D" & xCell).Value
                .CC = ""
                .BCC = ""
                .From = "" & Worksheets("ADMIN").Range("C22").Value & "<" & Worksheets("ADMIN").Range("C23").Value & ">"
                .Subject = frmEmail.fldSubject.Text
                .TextBody = strbody
                .Send
            End With
            If Err.Number <> 0 Then
                Range("A" & xCell).Value = "F"
                Range("A" & xCell).DisplayFormat.Interior.ColorIndex = iRed
            Else
                If frmEmail.btnNewUserEmail Then
                    Range("A" & xCell).Value = "N"
                    Range("A" & xCell).DisplayFormat.Interior.ColorIndex = Range("A1").DisplayFormat.Interior.ColorIndex
                End If
                If frmEmail.btnExistingUserEmail Then
                    Range("A" & xCell).Value = "E"
                    Range("A" & xCell).DisplayFormat.Interior.ColorIndex = Range("A1").DisplayFormat.Interior.ColorIndex
                End If
                If frmEmail.btnCustom Then
                    Range("A" & xCell).Value = "C"
                    Range("A" & xCell).DisplayFormat.Interior.ColorIndex = Range("A1").DisplayFormat.Interior.ColorIndex
                End If
            End If
            On Error GoTo 0
        Next
    End If
End If
End

Answer 1

Check your references by going to Tools->References in the VBA editor, make sure none are marked as "missing".

If no references are missing, then typically this is due to a corrupt workbook.

The solution is to create a new workbook and copy your VBA code into it.

This means you will need to recreate any worksheets, formatting etc that might be in your corrupted workbook.