從 Excel 發送郵件 - 運行時錯誤“429”：ActiveX 組件無法創建對象

Question

我必須重寫在 Win 上有效但在 Mac 上無效的代碼。

當我運行代碼時出現錯誤：

運行時錯誤“429”：ActiveX 組件無法創建對象

在行： Set iMsg = CreateObject("CDO.Message") 。

我已經通過互聯網谷歌了。

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

通過轉到 VBA 編輯器中的工具-> 參考來檢查您的參考，確保沒有標記為“缺失”。

如果沒有丟失任何引用，那么這通常是由於工作簿損壞造成的。

解決方案是創建一個新工作簿並將您的 VBA 代碼復制到其中。

這意味着您將需要重新創建可能在損壞的工作簿中的任何工作表、格式等。