Jak poslat e-mail, pokud byl v aplikaci Excel splněn termín splatnosti?
Jak je znázorněno na obrázku níže, pokud je datum splatnosti ve sloupci C menší nebo rovno 7 dnům (například aktuální datum je 2017/9/13), odešle se e-mail uvedenému příjemci ve sloupci A a obsah specifikovaný ve sloupci B se zobrazí v těle e-mailu. Jak byste toho mohli dosáhnout? Tento článek poskytuje kód VBA, který vám pomůže tento úkol splnit.
Pošlete e-mail, pokud bylo datum splatnosti splněno s kódem VBA
Pošlete e-mail, pokud bylo datum splatnosti splněno s kódem VBA
Chcete-li odeslat e-mail s připomenutím, pokud bylo v aplikaci Excel splněno datum splatnosti, postupujte takto.
1. zmáčkni Další + F11 současně otevřete Microsoft Visual Basic pro aplikace okno.
2. V Microsoft Visual Basic pro aplikace okno, klikněte prosím Vložit > Modul. Poté zkopírujte a vložte níže uvedený kód VBA do okna modulu.
Kód VBA: Pošlete e-mail, pokud je datum splatnosti uzavřeno v aplikaci Excel
Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i As Long
On Error Resume Next
Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
If xRgText Is Nothing Then Exit Sub
xLastRow = xRgDate.Rows.count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "<br><br>"
xMailBody = "<HTML><BODY>"
xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "</BODY></HTML>"
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End SubPoznámky: Linie Pokud CDate (xRgDateVal) - datum <= 7 A CDate (xRgDateVal) - datum> 0 Pak v kódu VBA znamená, že termín splatnosti musí být větší než 1 den a menší nebo rovný 7 dnům. Můžete to změnit podle potřeby.
3. lis ο Klávesa F5 ke spuštění kódu. V prvním vyskakování Kutools pro Excel V dialogovém okně vyberte rozsah sloupců splatnosti a poté klikněte na OK knoflík. Viz screenshot:
4. Potom druhý Kutools pro Excel Zobrazí se dialogové okno, vyberte odpovídající rozsah sloupců, který obsahuje e-mailové adresy příjemců, a klikněte na ikonu OK knoflík. Viz screenshot:
5. V posledním Kutools pro Excel V dialogovém okně vyberte obsah, který chcete zobrazit v těle e-mailu, a poté klikněte na ikonu OK .
Poté bude automaticky vytvořen e-mail s uvedeným příjemcem, subjektem a tělem, pokud je termín splatnosti ve sloupci C menší nebo roven 7 dnům. Klikněte prosím na Poslat tlačítko pro odeslání e-mailu.
Poznámky:
1. Každý vytvořený e-mail odpovídá datu splatnosti. Například pokud existují tři termíny splnění kritérií, budou automaticky vytvořeny tři e-mailové zprávy.
2. Tento kód se nespustí, pokud kritéria nesplňují žádná data.
3. Kód VBA funguje, pouze když používáte Outlook jako svůj e-mailový program.
Související články:
- Jak automaticky odesílat e-maily na základě hodnoty buňky v aplikaci Excel?
- Jak odeslat e-mail prostřednictvím aplikace Outlook, když je sešit uložen v aplikaci Excel?
- Jak odeslat e-mail, pokud je určitá buňka upravena v aplikaci Excel?
- Jak poslat e-mail, když kliknete na tlačítko v aplikaci Excel?
- Jak poslat e-mailem připomenutí nebo oznámení, pokud je sešit aktualizován v aplikaci Excel?
Nejlepší nástroje pro produktivitu v kanceláři
Rozšiřte své dovednosti Excel pomocí Kutools pro Excel a zažijte efektivitu jako nikdy předtím. Kutools for Excel nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času. Kliknutím sem získáte funkci, kterou nejvíce potřebujete...
Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci
- Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
- Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
- Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
