Error en enviar correo desde el excel

Tengo un error en la macro del botón de enviar correo, unas veces envía el correo bien. Otra lo envía en blanco, otra lo pega en la propia hoja, etc vamos que hace lo que quiere, y creo que la he realizado bien pero me falla . Me puede echar una mano, no se por que me falla

1 Respuesta

Respuesta
1

Incrementé el tiempo de espera para que outlook abra y envié el correo

Sub correo_Macro2()
    Suministrador = Range("C2").Value
    Fecha = Range("J2").Value
    correo = Range("L2").Value
    Range("A1:I50").Copy
    '
    Set parte1 = CreateObject("outlook.application")
    Set parte2 = parte1.createitem(olmailitem)
    parte2.To = correo
    parte2.Subject = "Reclamacion Pedidos" & Suministrador & " " & Fecha
    Parte2. Display
    Application. Wait Now + TimeValue("00:00:03")
    Application.SendKeys "^v", True
    DoEvents
    Application. Wait Now + TimeValue("00:00:03")
    DoEvents
    Parte2. Send
    Set parte1 = Nothing
    Set parte2 = Nothing
End Sub

Si continúan los problemas, entonces puede ser por tu versión de office, la alternativa sería que enviaras la información en un archivo.

Prueba con 3 segundos de diferencia si no te funciona, incrementa de 3 a 5 segundos y prueba nuevamente.

y como seria, para que me geenre un archivo y lo envia a la direccion del suministraador elegido

Te anexo una nueva macro para enviar el rango de celdas en un nuevo archivo, solamente cambia en la macro "PLANTILLA" por el nombre de la hoja que tiene el rango de celdas a enviar.

Sub EnviarHoja()
'Por.Dante Amor
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    '
    Set h = Sheets("PLANTILLA")
    Suministrador = h.Range("C2").Value
    Fecha = h.Range("J2").Value
    correo = h.Range("L2").Value
    h.Range("A1:I50").Copy
    Set h2 = Sheets.Add
    ActiveSheet.Paste
    '
    ruta = ThisWorkbook.Path & "\"
    nombre = Sheets(h.Name).Name
    h2.Copy
    ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
    ActiveWorkbook.Close False
    h2.Delete
    '
    Set dam = CreateObject("outlook.application").createitem(0)
    dam.To = correo
    dam.Subject = "Reclamacion Pedidos" & Suministrador & " " & Fecha
    dam.Attachments.Add ruta & nombre & ".xlsx"
    dam.Send
End Sub

Podrías crear una nueva pregunta para relacionar esta macro con la nueva pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas