ActiveX 429 错误：将 VBA 电子邮件代码从 Windows 移植到 Mac

如何解决ActiveX 429 错误：将 VBA 电子邮件代码从 Windows 移植到 Mac

我已经阅读了许多关于这个主题的问题，包括 macexcel.com，但没有找到解决我独特情况的答案。我不知道是否有任何特定的代码行已知无法在 Mac 上运行。该代码在 Windows 10 上运行良好。非常感谢任何建议。

Sub SendEmailsBulk_Init()
'This solution checks for rows with emails and looks at column AD for blank value
    Dim i As Long
    Dim lr As Integer
    Dim ws As Worksheet
    Dim Response,u As Long
    Dim body As Range
    Dim subj As String
    Dim STo As String
    Dim SendFromAcnt As String
    Dim SendFromAcntPswrd As String
    Dim Rslt As Integer
    
    u = 0
    '''''Application.ScreenUpdating = False
    Set ws = Sheet1
    lr = ws.Cells(Rows.Count,"E").End(xlUp).Row
    Rslt = MsgBox("Do you want to continue with sending a Gmail?",vbYesNo,"Please Respond")
    If Rslt = "6" Then

    SendFromAcnt = ws.Range("A2")
    SendFromAcntPswrd = ws.Range("A4")
    For i = 2 To ws.Cells(Rows.Count,"E").End(xlUp).Row
        If ((ws.Cells(i,"E").Value) <> "") And (ws.Cells(i,"H").Value = "") _
        And (ws.Cells(i,"I").Value = "") Then ' Email,sent-Notsent,Response
            Set body = ws.Range("R" & i)
            subj = ws.Cells(i,"K")
            STo = ws.Cells(i,"E").Value & ";" & Sheet1.Cells(i,"F").Value
            send_email_Gmail j:=i,rng:=body,Subject:=subj,Sendto:=STo,SFA:=SendFromAcnt,SFAP:=SendFromAcntPswrd,SendNow:=Response = vbYes
            ws.Cells(i,"I").Value = Date
            u = u + 1
        End If
        
    Next i
    
    If u = 0 Then
        MsgBox "No Email has been generated due to no email values,emails prevIoUsly sent or Response received on email"
    ElseIf u > 0 Then
        MsgBox u & " Email(s) has/have been created"
    End If
    
    Else
        MsgBox "The code will Now exit and not send any emails.",vbinformation,"Result"
    End If
    
    With Application
        .CutcopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub SendEmailsBulk_Init_O()
'This solution checks for rows with emails and looks at column AD for blank value
    Dim i As Long
    Dim lr As Integer
    Dim ws As Worksheet
    Dim Response,u As Long
    u = 0
    Application.ScreenUpdating = False
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(Rows.Count,"E").End(xlUp).Row 'For troubleshooting
    
          Response = MsgBox(prompt:="Do you want to send the emails immediately?" & vbCrLf & _
                                "Yes to send immediately" & vbCrLf & _
                                "No to generate and display them,but can be sent manually",_
                        Buttons:=vbYesNoCancel)
    
    For i = 2 To ws.Cells(Rows.Count,"I").Value = "") _
        And (ws.Cells(i,"H").Value = "") Then ' Email,Response
            Send_newemaili j:=i,emails prevIoUsly sent or Response received on email"
    ElseIf u > 0 Then
        MsgBox u & " Email(s) has/have been created"
    End If
    
    With Application
        .CutcopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub Send_newemaili(j As Long,SendNow As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim rngt As Range

    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)
    Set rng = Sheet1.Range("R" & j)
    
    With OutMail
            .To = Sheet1.Cells(j,"E").Value & ";" & Sheet1.Cells(j,"F").Value
            .CC = ""
            .Subject = Sheet1.Cells(j,"K")
            .HTMLBody = rng
            If SendNow Then
                .Send
            Else
                .display
            End If
            End With
            
   Set OutMail = nothing
   Set OutApp = nothing
    
End Sub

Sub send_email_Gmail(j As Long,rng As Range,Subject As String,Sendto As String,SFA As String,SFAP As String,SendNow As Boolean)

Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strbody As String


strSubject = Subject
strFrom = SFA '"email@gmail.com" '
strTo = Sendto 'Sheet1.Cells(j,"F").Value
strCc = ""
strBcc = ""
strbody = rng

Set CDO_Mail = CreateObject("cdo.message")
On Error GoTo Error_Handling

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1

Set SMTP_Config = CDO_Config.Fields

With SMTP_Config
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SFA '"email@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SFAP ' password
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 .Update
End With

With CDO_Mail
 Set .Configuration = CDO_Config
End With

CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.textbody = ""
CDO_Mail.HTMLBody = "< HTML >< BODY >" & strbody & "</ BODY >< /HTML >" 'strbody '
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send

Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description

End Sub

交叉发布于 ExcelForum 429 Error

解决方法

您正在使用 CDO 发送邮件（请参阅 CreateObject 行）。 CDO 只是一个 Windows 的 ActiveX 库，它在 Mac 上不存在，因此关于 ActiveX（它是一个在 Mac 上也不存在的对象框架）的错误。您需要找到一种在 Mac 上发送邮件的不同方式。