Macro no funciona para enviar correo desde excel

Tengo problema con la siguiente macro:

Sub Correo()

    For i = 2 To Range("P" & Rows.Count).End(xlUp).Row
        If UCase(Cells(i, "O")) = "ENVIAR" Then
            Set dam = CreateObject("outlook.application").createitem(0)
            dam.To = Cells(i, "P")           'Destinatario
            dam.Subject = Cells(i, "A")      '"Asunto"
            dam.Body = "Hola!! Dentro de 2 días se cambia las Dosis de Fertilización del Productor Mencionado en el Asunto, ¡¡AVÍSALE!!"
            dam.Send                        'Enviar correo
            'dam.Display                    'Muestra correo
        End If
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

El objetivo de esta macro es que cuando abra el archivo de Excel 2013 se ejecute esta macro automáticamente y me envíe por correo los recordatorios de todas las celdas que contengan la palabra "ENVIAR". El problema radica en que no funciona así como está, pues genera "error en el método subject de objeto Mailitem" y en Outlook no se cargan el destinatario ni el asunto y no se envía. Verifiqué la macro en modo depurar y cuando colocas el cursor sobre las referencias destinatario y asunto aparecen los datos correctos flotantes pero no los carga en Outlook, así que borré "Cells (i, "X") y escribí directamente la dirección del destinatario "[email protected]" y el asunto y solo así funciona bien, se envía y no genera error. Está activado Microsoft Outlook 15.0 Object Library, ¿hay alguna solución?

1 respuesta

Respuesta
1

H o l a:

¿Tienes el destinatario en la columna P?

¿Cómo se llama la hoja donde tienes los datos?

Prueba con la siguiente macro, cambia "Hoja1" por el nombre de la hoja en donde tienes los datos.

Sub Correo()
'Por.Dante Amor
    Set h = Sheets("Hoja1")
    For i = 2 To h.Range("P" & Rows.Count).End(xlUp).Row
        If UCase(h.Cells(i, "O")) = "ENVIAR" Then
            Set dam = CreateObject("outlook.application").createitem(0)
            dam.To = h.Cells(i, "P")            'Destinatario
            dam.Subject = h.Cells(i, "A")       '"Asunto"
            dam.Body = "Hola!! Dentro de 2 días se cambia las Dosis de Fertilización del Productor Mencionado en el Asunto, ¡¡AVÍSALE!!"
            dam.Send                            'Enviar correo
            'dam.Display                        'Muestra correo
        End If
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Si todavía tienes problemas, podrías enviarme tu archivo con la macro para revisarlo.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “” y el título de esta pregunta.

Avísame en esta pregunta cuando me lo hayas enviado.

':)

S a l u d o s . D a n t e   A m o r

':) Si es lo que necesitas. R ecuerda valorar la respuesta. G r a c i a s.

Envié a tu correo el archivo

H o l a:

Primero, para que la macro se ejecute cuando abres el archivo, tienes que poner esta macro en los eventos de Thisworkbook:

Private Sub Workbook_Open()
'Por.Dante Amor
    Call Correo
End Sub

Te anexo la macro actualizada:

Sub Correo()
'Por.Dante Amor
    Set h = Sheets("DATOS")
    For i = 6 To Range("S" & Rows.Count).End(xlUp).Row
        If UCase(h.Cells(i, "S")) = "ENVIAR" Then
            If h.Cells(i, "T") <> "" Then
                Set dam = CreateObject("outlook.application").createitem(0)
                dam.To = h.Cells(i, "T")         'Destinatario
                dam.Bcc = h.Range("T1")          'Copia oculta
                dam.Subject = h.Cells(i, "C")    '"Asunto"
                dam.Body = "Hola!! Dentro de 2 días se cambia las Dosis de " & _
                           "Fertilización del Productor Mencionado en el Asunto, ¡¡AVÍSALE!!"
                dam.Display                     'Muestra correo
                dam.Send                       'Enviar correo
            End If
        End If
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub


':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)

Esta es la macro final:

Sub Mail_with_outlook1()
'Act.Por.Dante Amor
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
    '
    For i = 6 To Range("S" & Rows.Count).End(xlUp).Row
        If UCase(Cells(i, "S")) = "ENVIAR" Then
            If Cells(i, "T") <> "" Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.createitem(0)
                strto = Cells(i, "T").Value
                'strcc = ""
                strbcc = Range("T1")
                strsub = Cells(i, "C").Value
                strbody = "Hola!! Dentro de 2 días se cambia las Dosis de " & _
                           "Fertilización del Productor Mencionado en el Asunto, ¡¡AVÍSALE!!"
                With OutMail
                    .To = strto
                    '.CC = strcc
                    .Bcc = strbcc
                    .Subject = strsub
                    .Body = strbody
                    .Display    ' or use .Send .display
                End With
                Set OutMail = Nothing
                Set OutApp = Nothing
            End If
        End If
    Next
End Sub

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)

¡Gracias! de verdad, creo que te di mucha lata pero en serio te lo agradezco, al final todo resultó muy bien, Saludos y que pases muy buenas noches!!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas