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
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.