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
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 SubSi 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 SubPodrías crear una nueva pregunta para relacionar esta macro con la nueva pregunta.
