Macro para búsqueda y envió de información a proveedores
No soy experta y nececito crear una macro que busque información de proveedores en la primera hoja y en la segunda que busque el correo electrónico y después que mande la información por correo con solo presionar un botón en excel.
1 Respuesta
Respuesta de Dante Amor
2
Con gusto te ayudo con la macro, envíame tu archivo con datos de ejemplo y me explicas con un proveedor, en dónde vas a poner el proveedor y qué datos hay que enviar.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario "IranBerlin Juarez" y el título de esta pregunta.
Muchas gracias ya fue enviada la información
Te anexo la macro para enviar correos en automático
Sub EnviarCorreos()
'Por.Dante Amor
Set h1 = Sheets("PENDIENTES")
Set h2 = Sheets("DIRECTORIO")
Set h3 = Sheets("Hoja3")
h3.Cells.Clear
h1.Rows(5).Copy h3.[A1]
'
For i = 5 To h2.Range("A" & Rows.Count).End(xlUp).Row
existe = False
Set r = h1.Columns("A")
Set b = r.Find(h2.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
existe = True
Do
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(b.Row).Copy h3.Rows(u)
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
If existe Then
h3.Range("A1:H" & u).Copy
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h2.Cells(i, "E")
dam.Subject = "DOCUMENTOS PENDIENTES"
dam.Body = "Buen día" & vbCr & _
"Estimada " & h2.Cells(i, "B") & " te hago llegar " & _
"la lista de pendientes al día de hoy" & vbCr
dam.Display
Application.Wait Now + TimeValue("00:00:02")
SendKeys "^{END}", True
DoEvents
SendKeys "^v", True
DoEvents
dam.send
End If
Next
End SubSaludos.Dante Amor
