Macro no funciona para enviar correo desde excel

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
':)