Control activex no puede crear el objeto

Utilizo la función que os copio para enviar emails desde access. Al principio funcionaba bien, pero desde hace un tiempo me salta el error 429 control activex no puede crear el objeto. En otros pcs funciona bien, en el que tengo la aplicación no (windows 10).

He probado todo lo que he visto por la red con regsvr32 ... Para volver a registrar bibliotecas DAO y sigue sin funcionar.

Intento referenciar DAO en VBA y me dice que el nombre entra en conflicto con un modulo, proyecto...

He probado a reparar Office 2007, y nada.

No se ya que hacer, ¿alguien puede ayudarme? Gracias

Este método utilizo:

Public Sub SendEMail(ByVal aSubject As String, ByVal aRecipients As String, Optional ByVal aBody As String = "", Optional ByVal aAttachments As String = "", Optional ByVal aRootPath As String = "")

Dim myO As Outlook.Application
Dim mobjNewMessage As Outlook.MailItem
Dim sRecipient, sAttachment, sDisplayName As String
Dim iMarker, iMarker2 As Integer
On Error GoTo Error_SendEMail
Set myO = CreateObject("Outlook.Application")
Set mobjNewMessage = myO.CreateItem(olMailItem)
mobjNewMessage.Subject = aSubject
mobjNewMessage.Body = aBody
Do
iMarker = InStr(1, aRecipients, ";", vbTextCompare)
If iMarker = 0 Then
sRecipient = aRecipients
Else
sRecipient = Mid(aRecipients, 1, iMarker - 1)
aRecipients = Mid(aRecipients, iMarker + 1)
End If
If Len(sRecipient) <> 0 Then mobjNewMessage.Recipients.Add sRecipient
Loop While iMarker <> 0
Do
iMarker = InStr(1, aAttachments, ";", vbTextCompare)
If iMarker = 0 Then
sAttachment = aAttachments
Else
sAttachment = Mid(aAttachments, 1, iMarker - 1)
aAttachments = Mid(aAttachments, iMarker + 1)
End If
If Len(sAttachment) <> 0 Then
iMarker2 = InStr(1, sAttachment, "***", vbTextCompare)
If iMarker2 <> 0 Then
sDisplayName = Mid(sAttachment, iMarker2 + 3)
sAttachment = aRootPath + Mid(sAttachment, 1, iMarker2 - 1)
If StrComp(Dir(sAttachment), "", vbTextCompare) <> 0 Then mobjNewMessage.Attachments.Add sAttachment, , , sDisplayName
Else
If StrComp(Dir(aRootPath + sAttachment), "", vbTextCompare) <> 0 Then mobjNewMessage.Attachments.Add aRootPath + sAttachment
End If
End If
Loop While iMarker <> 0
mobjNewMessage.Send
Exit_SendEMail:

Set mobjNewMessage = Nothing
Set myO = Nothing
Exit Sub

Error_SendEMail:
MsgBox Err.Description, , "Send Mail Error"
Resume Exit_SendEMail
End Sub