Office Guru

Automatikus értesítésküldés Excelből meghatározott időpontban

2017. augusztus 12. - Office Guru

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:

levelk.JPGÉ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

A bejegyzés trackback címe:

https://officeguru.blog.hu/api/trackback/id/tr3612741178

Kommentek:

A hozzászólások a vonatkozó jogszabályok  értelmében felhasználói tartalomnak minősülnek, értük a szolgáltatás technikai  üzemeltetője semmilyen felelősséget nem vállal, azokat nem ellenőrzi. Kifogás esetén forduljon a blog szerkesztőjéhez. Részletek a  Felhasználási feltételekben és az adatvédelmi tájékoztatóban.

Coolya 2017.08.29. 14:56:22

Sziasztok!

Ha több azonos napon lejáró dátum van nekem csak a legutolsót veszi figyelembe.
Van erre megoldás?
Köszi

_kolléga_ · https://radicspeter.hu 2017.08.29. 21:01:15

így kipróbálás (meg ismertek :) nélkül: tedd a
Set Outlookprogi = CreateObject("Outlook.Application")
Set Email = Outlookprogi.CreateItem(0)

sorokat a
If Cells(i, 3) = Date Then
sor áutánra (a with elé)

_kolléga_ · https://radicspeter.hu 2017.08.29. 21:06:57

@_kolléga_: ja nem, bocs hülyeséget írtam :)
bár lehet, ha a End With után emellett átteszed a
Set Email = Nothing
Set Outlookprogi = Nothing
sorokat, akár jó is lesz

_kolléga_ · https://radicspeter.hu 2017.08.29. 21:14:30

mondjuk így működik, bár - vsz - nem szép:

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
Set Outlookprogi = CreateObject("Outlook.Application")
Set Email = Outlookprogi.CreateItem(0)
With Email
.To = "officeguruhelp@gmail.com"
.cc = ""
.Subject = Cells(i, 2).Value
.Body = "EzProblema?"
.Attachments.Add
.display
End With
Set Email = Nothing
Set Outlookprogi = Nothing
End If
Next

End Sub

_kolléga_ · https://radicspeter.hu 2017.08.29. 21:15:40

pontosabban így (többet nem írok ígérem :):

Private Sub X()
Dim Outlookprogi As Object
Dim Email As Object

On Error Resume Next

For i = 4 To Range("C65536").End(xlUp).Row
If Cells(i, 3) = Date Then
Set Outlookprogi = CreateObject("Outlook.Application")
Set Email = Outlookprogi.CreateItem(0)
With Email
.To = "officeguruhelp@gmail.com"
.cc = ""
.Subject = Cells(i, 2).Value
.Body = "EzProblema?"
.Attachments.Add
.display
End With
Set Email = Nothing
Set Outlookprogi = Nothing
End If
Next

End Sub

zsolt83 2018.07.25. 14:44:53

Sziasztok

Szeretném kicsit kibővíteni a makrót azzal hogy minden egyes projekthez több e-mail cím tartozik.
Értelemszerűen csak azoknak menjen automatikusan az e-mail, amelyik projekt éppen lejárt.
A címek melletti oszlopban minden címzett mellé hozzá van rendelve a megfelelő projekt.

Milyen megoldást javasolnátok?

Köszi!

_kolléga_ · https://radicspeter.hu 2018.08.27. 20:57:18

@zsolt83: eltekintve az egyszerű verziótól (ti., hogy minden projekthez csinálsz egy terjesztési listát /a címzettekkel/ az outlookban, és akkor a fenti kód továbbra is elég), olyan irányban kellene kibővíteni az excelt (és a kódot), hogy pld. a határidő oszlop után van egy címzett(ek) száma oszlop, és azt egy belső for next végigolvassa, és szépen a
"With Email .To = "officeguruhelp@gmail.com" résznél hozzáadja a címzetteket

ha probléma még (és lesz kedvem/időm), megírom

Tridio_1 2019.06.06. 09:47:04

Sziasztok,

Nekem lenne egy olyan kérdésem, hogy hogyan kérhetek olvasási visszaigazolást?
Outlook-ot használok, abban be van állítva, hogy minden elküldött levélre kérek visszaigazolást, érdekes módon a magamnak küldött email ad visszaigazolást, ha másnak akkor nem...:(
van erre valamilyen ötlet, megoldás?
süti beállítások módosítása