A legutóbbi posztban említett olvasói kérdés második részére fogok kitérni ebben az írásban röviden, azaz hogyan lehet egy munkalapon lévő feladatlistából azokról az feladatokról automatikus emailt küldeni, amelyeknek lejárt a határideje vagy éppen itt az idő egy figyelmeztetésre. Azt tehát már megbeszéltük korábban, hogyan lehetne egy makrót Excelen kívülről elindítani, most nézzük meg, hogy milyen módon küldünk meghatározott időpontban levelet Outlookon keresztül.
Ebben az írásban még két éve már átnéztük egyszer az automatikus levélküldés makróját, most pedig ugyanezt a kódot fogjuk kicsit kiegészíteni. Adott ez a roppant egyszerű táblázat:
Értelemszerűen bővíthetjük e-mailcímmel, standard szöveggel, címzettel, cc-vel, de a logikát ezen a két oszlopon keresztül is könnyedén meg fogjuk érteni. Szóval a 2015-ös poszt kódját mindösszesen két extra sorral (meg a lezárókkal) kell kibővítenünk a With..End With utasítás előtt a példánkban, méghozzá ezzel a kettővel:
For i = 4 To Range("C65536").End(xlUp).Row
If Cells(i, 3) = Date Then
.
.
.
End If
Next
Mit is csinál ez? A negyedik sortól kezdődően a C oszlop 65536. soráig bezárólag létező tartományban megnézi melyik az utolsó sor, amiben érték van és eddig fogja ismételni a ciklust, majd megnézi az összes ilyen sort a negyediktől kezdődően - majd ha az ebben található érték megegyezik a mai dátummal, akkor folytatja a kódot az e-mail megnyitásával és mezőinek feltöltésével. És egészen addig csinálja ezt, amíg van értékkel bíró cella a C oszlopban. A levelet csak megjeleníti, nem fogja automatikusan még elküldeni.
Aztán ha már ilyen a példatábla, akkor még a Tárgyat írjuk át, hogy a B oszlopból vegye fel az adott sor értékét:
.Subject = Cells(i, 2).Value
És nagyjából kész is vagyunk az alapokkal, innentől kezdve már lehet tuningolni, ahogy szeretnénk - a többi e-mail mezőt is feltölthetjük az Excelből, rakhatunk be egy "Elküldött" oszlopot, amelyben a makrónk megvizsgálja, hogy van-e IGEN válasz és csak arra küld, ahol nincs ilyen és így tovább.
Szövegként a teljes kód a 2015-ös alappal:
Private Sub X()
Dim Outlookprogi As Object
Dim Email As Object
Set Outlookprogi = CreateObject("Outlook.Application")
Set Email = Outlookprogi.CreateItem(0)
On Error Resume Next
For i = 4 To Range("C65536").End(xlUp).Row
If Cells(i, 3) = Date Then
With Email
.To = "officeguruhelp@gmail.com"
.cc = ""
.Subject = Cells(i, 2).Value
.Body = "Problema"
.Attachments.Add
.display
End With
End If
Next
Set Email = Nothing
Set Outlookprogi = Nothing
End Sub