Automatisch een e-mail versturen wanneer een datum in een cel verstreken is.

inMilu · 1 dec 2015

Beste gebruikers,

Zoals de titel al beschrijft, ben ik op zoek naar een automatisch e-mail macro dat verstuurd wordt a.d.v. een datum.

Ik had al gegoogled om het uit te vinden en stuitte op deze link http://www.computing.net/answers/office/excel-vba-to-email-row-data-based-on-date/10641.html comment #7. Heb zijn code geprobeerd, maar kreeg het helaas niet voor elkaar.

Middels Windows Takenplanner kan het Excel volgens mij dagelijks geopend worden, en bij het openen zou een macro het bestand kunnen controleren.

Wat ik graag wil bereiken is dat:
- Windows Takenplanner opent het Excelfile op de achtergrond.
- Zodra het Excelfile geopend wordt, start de macro automatisch.
- De macro zoekt in kolom F of er een datum is die binnen 7 dagen bereikt is.
- Als er een datum binnen 7 dagen bereikt is, dan een e-mail versturen met Outlook.
- Als er geen datum gevonden is het Excelfile weer sluiten.

Nu zie ik ook 2 problemen nog.

1: Stel dat een einddatum op a.s. vrijdag is, dan wil ik eenmalig een mail ontvangen. En niet elke dag tot aan vrijdag. Misschien moet er dan een input gegeven worden wanneer een mail verstuurd wordt, en dat hij alleen een mail stuurt wanneer bij dat item geen input staat. Bijv. item uit rij 3 verloopt binnen 7 dagen, er wordt een mail gestuurd en in kolom A komt een waarde te staan. Vervolgens stuurt Excel enkel een email wanneer er in kolom A geen waarde is ingevoerd.

2: Wat ik ook ondervond met het proberen van de code die ik hierboven linkte is, wanneer hij automatisch de macro uitvoert bij het openen van het bestand en er is geen item dat verloopt binnen 7 dagen, dan sluit hij het af. Wanneer ik dan een nieuw item wil toevoegen lukt dit niet. Moet er dan bijvoorbeeld met 2 bestanden gewerkt worden?

Ik hoop dat er iemand is die mij hier verder mee kan helpen. Er staat een testbestandje in de bijlage, mocht dat helpen.

Alvast heel erg bedankt!

Bekijk bijlage Testbestand.xlsx

HSV · 1 dec 2015

Hier is een begin.
Code plaatsen in Thisworkbook en bestand opslaan met macrogebruik.

Code:

Private Sub Workbook_Open()
Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In sheets(1).Columns(6).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
             cl.Offset(, -5) = "verzonden"
              .Bcc = "[EMAIL="jemailadres@gmail.com"]jemailadres@gmail.com[/EMAIL]"
              .Subject = "Er is een datum dat valt binnen nu en 7 dagen in cel " & cl.Address
              .body = "gefeliciteerd"
              .Send
            End If
           End If
        Next cl
    End With
End Sub

inMilu · 2 dec 2015

Goedemorgen HSV,

Bedankt voor je reactie. Dit werkt inderdaad wanneer ik de macro in het VBA scherm run. Nu heb ik zelf een code toegevoegd die het bestand sluit na 30 seconden idle tijd. Wanneer ik het bestand nu manueel open en niks doe sluit hij inderdaad na 30 seconden zichzelf af. Hij stuurt echter niet vanzelf de e-mail.

De code die ik nu heb:
ThisWorkBook:

Code:

Private Sub Workbook_Open()
 StartTimer

Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In Sheets(1).Columns(6).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
             cl.Offset(, -5) = "verzonden"
              .Bcc = "mijnemail@mijnemail.com"
              .Subject = "Er is een datum dat valt binnen nu en 7 dagen in cel " & cl.Address
              .body = "Milu, er vervalt een actie binnen nu en 7 dagen."
              .Send
            End If
           End If
        Next cl
    End With
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StartTimer
End Sub

En deze code in een Module(Timer even op 300 gezet om afsluiten te voorkomen):

Code:

Const idleTime = 300 'seconds
Dim Start
Sub StartTimer()
    Start = Timer
    Do While Timer < Start + idleTime
        DoEvents
    Loop
    Application.DisplayAlerts = False
    ActiveWorkbook.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub

Alvast bedankt bij het helpen!

snb · 2 dec 2015

Het lijkt me verstandiger het bestand af te sluiten nadat de email verzonden is resp. de email check heeft plaatsgevonden.

inMilu · 2 dec 2015

Lijkt mij ook haha. De timer moet wel uit zichzelf plaatsvinden en dus wel in de Workbook_Open() staan toch? Als ik de starttimer na de code van HSV zet ( na End With ) dan zet de code van HSV nog wel in kolom A het woord verzonden, maar de e-mail zelf wordt niet meer verzonden.

Enig idee hoe ik dit corrigeer?

Heb nu:

Code:

Private Sub Workbook_Open()
Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In Sheets(1).Columns(6).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
             cl.Offset(, -5) = "verzonden"
              .Bcc = "michael.luijken@scania.com"
              .Subject = "Er is een datum dat valt binnen nu en 7 dagen in cel " & cl.Address
              .body = "gefeliciteerd"
              .Send
            End If
           End If
        Next cl
    End With
StartTimer

End Sub




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StartTimer
End Sub

snb · 2 dec 2015

"Er is een datum die

vervang starttimer door

Code:

thisworkbook.close 0

Warme bakkertje · 2 dec 2015

Code:

Private Sub Workbook_Open()
    Dim cl As Range
    With CreateObject("Outlook.Application").CreateItem(0)
        For Each cl In Sheets(1).Columns(6).SpecialCells(2)
            If IsDate(cl) Then
                If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
                    cl.Offset(, -5) = "verzonden"
                    [COLOR="#FF0000"].To = "jemailadres@gmail.com"[/COLOR]
                    '.Bcc = "jemailadres@gmail.com"
                    .Subject = "Er is een datum dat valt binnen nu en 7 dagen in cel " & cl.Address
                    .Body = "gefeliciteerd"
                    .Send
                End If
           End If
        Next cl
    End With
End Sub

inMilu · 2 dec 2015

Bakkertje, bedankt voor de reactie. Zowel .to als .bcc werkte beiden.

Ik heb het werkend gekregen met de timer door deze verandering:

Code:

Private Sub Workbook_Open()

Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In Sheets(1).Columns(6).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
              .To = "michael.luijken@scania.com"
              .Subject = "Er is een datum die verloopt binnen nu en 7 dagen in cel " & cl.Address
              .body = "gefeliciteerd"
              .Send
             End If
              cl.Offset(, -5) = "verzonden"
           End If
        Next cl
    End With
StartTimer

End Sub




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StartTimer
End Sub

Omdat hij meteen in een cel het woord "verzonden" noteerde, zorgde de

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StartTimer

ervoor dat hij direct doorging naar de timer, ipv het mailtje sturen. Op deze manier werkt het, deels.

In het voorbeeld bestand staan er momenteel 2 items in. Het werkt met bovenstaande code prima, maar wel voor 1 regel. Het lijkt alsof de code in kolom A zoekt naar het woord Verzonden, en als dat er staat wordt er niks gemaild. Als de volgende dag item #2 verloopt, dan maild hij het niet. Hoe kan ik dit oplossen?

HSV · 2 dec 2015

Haal de startimer uit de sheet_change event.
Sluit het bestand met:

Code:

 end with
  application.wait dateadd("s",30,now)
  thisworkbook.close 1
end sub

inMilu · 3 dec 2015

Hoi HSV,

Wanneer ik de Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) en bijbehorende module verwijder, en
application.wait dateadd("s",30,now)
thisworkbook.close 1

toevoeg, dan kan ik het bestand niet meer openen. Hij sluit hem nu automatisch wanneer er geen items zijn om te mailen. Nu kan ik dus geen items toevoegen op deze manier. Dat hij automatisch sluit mag/moet wel, maar enkel na 30s idle tijd. Dus als ik het bestand open moet ik meteen gaan typen etc.

Ik had het overigens zo toegevoegd, misschien op de verkeerde plek?

Code:

Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In Sheets(1).Columns(6).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value - 7 <= Date And cl.Offset(, -5) = "" Then
              .To = "michael.luijken@scania.com"
              .Subject = "Er is een datum die verloopt binnen nu en 7 dagen in cel " & cl.Address
              .body = "gefeliciteerd"
              .Send
             End If
              cl.Offset(, -5) = "verzonden"
           End If
        Next cl
        application.wait dateadd("s",30,now)
        thisworkbook.close 1
    End With


End Sub

Zorgt application.wait ervoor dat je tijdens die 30 seconden het file niet meer kan gebruiken? Tijdens die 30 seconden kan ik namelijk niet meer in de VBA komen, of het bestand aanpassen. Het lijkt te 'freezen' en na 30 seconden sluit het zichzelf inderdaad.

Wat je volgens mij wilt bereiken met de application.wait is dat hij wacht met de application.outlook starten. en deze na 30seconden uitvoeren. Dus moet ik wellicht de application.wait aan het begin van de code zetten? ( Leest Excel de code ook van boven naar beneden?)

snb · 3 dec 2015

Ik geloof er niets van dat zonder die wachtinstruktie de mail niet verzonden wordt. Hij staat dan wellicht in Outlook nog in PostvakUit en nog niet in SentItems, maar verzonden wordt ie.

pixcel · 3 dec 2015

Alternatief: helemaal geen timer gebruiken, gewoon lekker laten lopen.
Als je een keer het bestand wilt openen om items toe te voegen hou je de linker Shift toets ingedrukt tijdens het openen.

inMilu · 4 dec 2015

pixcel zei:
Alternatief: helemaal geen timer gebruiken, gewoon lekker laten lopen.
Als je een keer het bestand wilt openen om items toe te voegen hou je de linker Shift toets ingedrukt tijdens het openen.

Bedankt voor de tip, zo kom ik inderdaad het bestand in zonder dat hij de macro uitvoert!

Automatisch een e-mail versturen wanneer een datum in een cel verstreken is.

inMilu

Gebruiker

HSV

Inventaris

inMilu

Gebruiker

snb

Verenigingslid

inMilu

Gebruiker

snb

Verenigingslid

Warme bakkertje

Meubilair

inMilu

Gebruiker

HSV

Inventaris

inMilu

Gebruiker

snb

Verenigingslid

pixcel

Gebruiker

inMilu

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy