Páginas

jueves, 12 de junio de 2014

Macro Excel para calcular vencimiento de fechas y enviar email

A continuación muestro una macro de Excel ,que puede resultar útil para validación de fechas entre columnas, y enviar alertas por email a traves de outlook:


Sub Vencimiento()
    Dim nFila As Double
    Dim rCelda As Range
    Dim sVencimiento As String
    Dim n As Double
    Dim sFactVence As String
    Dim bFactVencidas As Boolean
 
 
    'Contamos Filas
    bFactVencidas = False
    nFila = Worksheets("FINAL").Range("A" & Rows.Count).End(xlUp).Row
    
    'Revisamos la fecha de vencimiento 
    'si está vencida o si vence a 1,2, 3, 4 o mas meses
    For Each rCelda In Worksheets("FINAL").Range("D2:D" & nFila)
        Select Case (rCelda.Value - Date)
            Case Is >= 120
                sVencimiento = "Mayor a 4 Meses"
            Case Is >= 90
                sVencimiento = "4 Meses"
            Case Is >= 60
                sVencimiento = "3 Meses"
            Case Is >= 30
                sVencimiento = "2 Meses"
            Case Is > 0
                sVencimiento = "1 Mes"
            Case Else
                sVencimiento = "Vencida"
        End Select
        rCelda.Offset(0, 11).Value = sVencimiento
    Next
    
    'Revisamos si paso de vencimiento
    For Each rCelda In Worksheets("FINAL").Range("O2:O" & nFila)
        If rCelda.Value <> "Vencida" Then
           sFactVence = sFactVence & "--- " & Chr(10) & _
           "VENCIMIENTO EN : " & rCelda.Value & Chr(10) & _
           "CAMPO1: " & rCelda.Offset(0, -13).Value & Chr(10) & _
           "CAMPO2: " & rCelda.Offset(0, -12).Value & Chr(10) & _
           "CAMPO3: " & rCelda.Offset(0, -11).Value & Chr(10) & _
           "--- " & Chr(10) & Chr(10)
            'rCelda.Value = "SI"
            bFactVencidas = True
        End If
    Next
    
    'enviamos el correo
    If bFactVencidas = True Then
        Call Enviar_Correo(sFactVence)
    End If
End Sub

Sub Enviar_Correo(ByVal sFacturas As String)
    
    Set fase1 = CreateObject("outlook.application")

    Set fase2 = fase1.CreateItem(olMailItem)
    fase2.To = "midir@email.com"
    fase2.Subject = "Informes "
    
    fase2.Body = "Informes  " & Chr(10) & _
                 "_________ " & Chr(10) & Chr(10) & sFacturas
    
    'fase2.Attachments.Add ActiveWorkbook.FullName
    
    fase2.Send
    
    Set correo1 = Nothing
    
    Set correo2 = Nothing
End Sub



una web muy util para realizar este tipo de macros -> http://www.rondebruin.nl/win/section1.htm
 

3 comentarios:

  1. Hola, cuál es el formato en excel? es decir, los nombres de las columnas.

    ResponderEliminar
    Respuestas
    1. Nombre de hoja "FINAL”, Pero retocando el código puedes hacer lo que quieras. Las columnas que uso son D2: hasta el final y O2: hasta el final.

      Espero haberte ayudado,

      Eliminar
  2. Este comentario ha sido eliminado por el autor.

    ResponderEliminar