Macro Control y Aviso "Estado" de facturas a proveedores por correo
1. Se tiene un archivo xlsx con n hojas de trabajo, una factura por cada hoja
2. Se generó una macro (La macro funciona bien) la cual crea automáticamente una nueva hoja de trabajo dentro del xlsx llamada "resumen", la cual contiene parte de la información
de cada una de las hojas, esta información es:
Contenido de la hoja "Resumen":
A1 A2 A3 A4 A5
No. Factura Fecha Factura Estado Factura Valor Factura Mail del Proveedor
... Contenido de "resumen" n Registros
Nota: La columna Estado Factura tiene los siguiente valores: "Pagado" o "Anulada" o "pendiente"
3. Se creó una macro (La macro funciona bien) que envía por correo (mail del proveedor) avisándole el estado de su factura. PERO no controla avisos
4. Dam, se requiere una macro que CONTROLE el No. De veces (que debe ser una) de avisos al proveedor, es decir, si YA SE "PAGO" la macro debe
"marcar" ese registro y NO AVISAR más a ese proveedor de su pago o estado de cuenta, EXCEPTO CUANDO PASA DE "PENDIENTE" A "PAGADO"
Observación: Tengo una macro que Si realizo por ejemplo que cortes de aviso en el día, me envía que veces de "Pagado" o "Anulada" o "pendiente" al proveedor, esto no está bien
La idea es que avise a los nuevos proveedores que aparecen en ese periodo de corte.
Tener en cuenta que una factura puede estar ahora en estado "pendiente" y en dos horas después (corte) pasa a estado "pagado",
en este caso debe enviar el correo de aviso de "pagado" al proveedor, marcar registro y no volver a avisar
1 Respuesta
Envíame un archivo con varios ejemplos, cada ejemplo me lo explicas con comentarios. Qué datos se deben enviar en el correo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Luis Fernando Gomez Galeano” y el título de esta pregunta.
Dam, ya envié lo solicitado
Gracias
Macro 1
'***Macro Para enviar correos
Sub correo()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("PAGOS")
Set h2 = Sheets("Avisados")
col = h1.Range("H1").Column
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("A").Find(h1.Cells(i, "A"), lookat:=xlWhole)
If b Is Nothing Then
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h1.Range("B" & i).Value 'Destinatarios
dam.CC = h1.Range("C" & i).Value 'Con copia
dam.Bcc = h1.Range("D" & i).Value 'Con copia oculta
dam.Subject = h1.Range("E" & i).Value '"Asunto"
dam.Body = h1.Range("F" & i).Value '"Cuerpo del mensaje"
'
For j = col To h1.Cells(i, Columns.Count).End(xlToLeft).Column
archivo = h1.Cells(i, j).Value 'archivo
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.Send 'El correo se envía en automático
'dam.Display 'El correo se muestra
Set dam = Nothing
If h1.Cells(i, "C").Value = "Pagado" Then
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h2.Rows(u)
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Correos enviados", vbInformation, ""
End Submacro 2
Sub proceso()
'Reporte Consolidado de todas las hojas
Dim Starttim, Nombre0 As Double, Endtime As Double
Application.ScreenUpdating = False
Application.DisplayAlerts = False
starttime = Timer
nombre = "PAGOS"
On Error Resume Next
Sheets(nombre).Delete
On Error GoTo 0
'
Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
Set h = ActiveSheet
h.Name = nombre
h.Range("A1").Value = "No. Factura"
h.Range("B1").Value = "Correo Electrónico"
h.Range("C1").Value = "Estado Pago"
h.Range("D1").Value = "Beneficiario"
h.Range("E1").Value = "Asunto"
h.Range("F1").Value = "Cuerpo del mensaje"
h.Range("G1").Value = "NIT"
h.Range("H1").Value = "Anexo"
'
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name <> nombre Or hoja.Name <> "Avisados" Then
If hoja.Range("d15").Value <> 0 Then
hoja.Range("d15").Copy
h.Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("d22").Copy
h.Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("k16").Copy
h.Range("C65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("k20").Copy
h.Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("k22").Copy
h.Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("d38").Copy
h.Range("E65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
hoja.Range("c15").Copy
h.Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("c22").Copy
h.Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("h16").Copy
h.Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("h20").Copy
h.Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("h22").Copy
h.Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
hoja.Range("c38").Copy
h.Range("E65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
End If
Next
Application.ScreenUpdating = True
tiempo = Format((Timer - starttime) / 60, "#0.00000000")
MsgBox "Tiempo Ejecución en Minutos : " & tiempo, , "Proceso Finalizado Exitosamente"
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
