I have just found this code below, but I cannot get it to work... When it opens, I get

"Run Time Error '429':
ActiveX component can't create object

Code:
Private Sub command1_click()
call SendEmail("[email protected]","[email protected]", "test subject", "test email")
end sub

' Sends an email to the appropriate person(s)
'
' SendTo = List of email addresses separated by a semicolon.  Example:
'                          [email protected]; [email protected]; [email protected]
' Subject = Text that summarizes what the email is about
' EmailText = Body of text that is the email
' AttachmentPath = Directory in which the attachment resides
' Attachment = File to send with the email

Sub SendEmail(From As String, SendTo As String, Subject As String, _
    EmailText As String, Optional AttachmentPath As String, _
    Optional Attachment As String, Optional CC As String)
    Const constRoutine As String = "SendEmail"

    Dim strSendTo As String
    Dim objSendMail As CDONTS.NewMail
    Dim i As Integer

    On Error GoTo TryMAPI
    
    'Do not cause the user a major error, just log the error and keep going
    If SendTo = "" Then Exit Sub

    Set objSendMail = New CDONTS.NewMail

    With objSendMail
        On Error Resume Next
        .From = From
        If CC <> "" Then
            .CC = CC
        End If

        On Error GoTo ErrorHandler
        .To = SendTo
        .Subject = Subject
        .Body = EmailText
        AttachmentPath = Trim$(AttachmentPath)
        
        If AttachmentPath <> "" Then
            If Right$(AttachmentPath, 1) <> "\" Then
                AttachmentPath = AttachmentPath & "\"
            End If
            .AttachFile (AttachmentPath & Attachment)
        End If
        .Send
    End With

    GoTo ExitMe

TryMAPI:
    On Error GoTo ErrorHandler

    'If CDO fails, try MAPI
    If CC <> "" Then
        strSendTo = SendTo & "; " & CC
    Else
        strSendTo = SendTo
    End If

    Call SendEmailMAPI(SendTo:=strSendTo, Subject:=Subject, _
        EmailText:=EmailText)

ExitMe:
    Set objSendMail = Nothing
    Exit Sub

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
    Resume ExitMe

End Sub

' Sends an email to the appropriate person(s).
' SendTo = List of email addresses separated by a semicolon.  Example:
'                 [email protected]; [email protected]; [email protected]
' Subject = Text that summarizes what the email is about
' EmailText = Body of text that is the email
' AttachmentPath = Directory in which the attachment resides
' Attachment = File to send with the email

Sub SendEmailMAPI(SendTo As String, Subject As String, EmailText As String, _
    Optional AttachmentPath As String, Optional Attachment As String)
   Const constRoutine As String = "SendEmailMAPI"

   Dim intStart As Integer
   Dim strSendTo As String
   Dim intEnd As Integer
   Dim i As Integer

   On Error GoTo ErrorHandler
   
   If frmEmailCommon.MAPISession.SessionID = 0 Then
      frmEmailCommon.MAPISession.SignOn
   End If

   If SendTo = "" Then Exit Sub

   With frmEmailCommon.MAPIMessages
      .SessionID = frmEmailCommon.MAPISession.SessionID
      .Compose

      'Make sure that the SendTo always has a trailing semi-colon (makes it 
      ' easier below)
      'Strip out any spaces between names for consistency
      For i = 1 To Len(SendTo)
         If Mid$(SendTo, i, 1) <> " " Then
            strSendTo = strSendTo & Mid$(SendTo, i, 1)
         End If
      Next i

      SendTo = strSendTo
      If Right$(SendTo, 1) <> ";" Then
         SendTo = SendTo & ";"
      End If

      'Format each recipient, each are separated by a semi-colon, like this:
      '  [email protected];[email protected]; [email protected];
      intEnd = InStr(1, SendTo, ";")
      .RecipAddress = Mid$(SendTo, 1, intEnd - 1)
      .ResolveName

      intStart = intEnd + 1
      Do
         intEnd = InStr(intStart, SendTo, ";")
         If intEnd = 0 Then
            Exit Do
         Else
            .RecipIndex = .RecipIndex + 1
            .RecipAddress = Mid$(SendTo, intStart, intEnd - intStart)
            .ResolveName
         End If
         intStart = intEnd + 1
      Loop

      .MsgSubject = Subject
      .MsgNoteText = EmailText
      If Left$(Attachment, 1) = "\" Then
         Attachment = Mid$(Attachment, 2, Len(Attachment))
      End If

      If Attachment <> "" Then
         If Right$(AttachmentPath, 1) = "\" Then
            .AttachmentPathName = AttachmentPath & Attachment
         Else
            .AttachmentPathName = AttachmentPath & "\" & Attachment
         End If
        .AttachmentName = Attachment
      End If
      .Send False
   End With

ExitMe:
   Exit Sub

ErrorHandler:
   Err.Raise Err.Number, m_constPgm & constRoutine, Err.Description 
   Resume ExitMe

End Sub