Przejdź do głównej zawartości

Jak wysłać wiadomość e-mail, jeśli termin został osiągnięty w programie Excel?

Jak pokazano na poniższym zrzucie ekranu, jeśli termin płatności w kolumnie C jest krótszy lub równy 7 dni (na przykład aktualna data to 2017/9/13), wiadomość e-mail jest wysyłana do określonego odbiorcy w kolumnie A, a określona treść w kolumnie B jest wyświetlana w treści wiadomości e-mail. Jak mogłeś to zrobić? Ten artykuł zawiera kod VBA, który pomoże Ci wykonać to zadanie.

Wyślij e-mail, jeśli termin został osiągnięty z kodem VBA


Wyślij e-mail, jeśli termin został osiągnięty z kodem VBA

Wykonaj następujące czynności, aby wysłać e-mail z przypomnieniem, jeśli termin został osiągnięty w programie Excel.

1. wciśnij inny + F11 klawisze jednocześnie, aby otworzyć Microsoft Visual Basic for Applications okno.

2. w Microsoft Visual Basic for Applications kliknij wstawka > Moduł. Następnie skopiuj i wklej poniższy kod VBA do okna Module.

Kod VBA: wyślij wiadomość e-mail, jeśli termin jest zamknięty w programie 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 Sub

Uwagi: Linia Jeśli CDate (xRgDateVal) - Date <= 7 oraz CDate (xRgDateVal) - data> 0 Wtedy w kodzie VBA oznacza, że ​​termin płatności musi być dłuższy niż 1 dzień i krótszy lub równy 7 dni. Możesz to zmienić według potrzeb.

3. naciśnij dotychczasowy Klawisz F5, aby uruchomić kod. W pierwszym wyskakującym okienku Kutools dla programu Excel W oknie dialogowym wybierz zakres kolumn dat ukończenia, a następnie kliknij OK przycisk. Zobacz zrzut ekranu:

4. Następnie drugi Kutools dla programu Excel pojawi się okno dialogowe, wybierz odpowiedni zakres kolumn, który zawiera adresy e-mail odbiorców, i kliknij OK przycisk. Zobacz zrzut ekranu:

5. W ostatnim Kutools dla programu Excel W oknie dialogowym wybierz zawartość, którą chcesz wyświetlić w treści wiadomości e-mail, a następnie kliknij OK przycisk.

Następnie wiadomość e-mail zostanie utworzona automatycznie z określonym odbiorcą, tematem i treścią, jeśli termin w kolumnie C jest krótszy lub równy 7 dni. Proszę kliknąć Wyślij przycisk, aby wysłać wiadomość e-mail.

Uwagi:

1. Każdy utworzony e-mail odpowiada terminowi wykonania. Na przykład, jeśli istnieją trzy terminy spełniające kryteria, trzy wiadomości e-mail zostaną utworzone automatycznie.

2. Ten kod nie zostanie uruchomiony, jeśli nie ma dat spełniających kryteria.

3. Kod VBA działa tylko wtedy, gdy używasz Outlooka jako programu pocztowego.


Podobne artykuły:

Najlepsze narzędzia biurowe

🤖 Pomocnik AI Kutools: Zrewolucjonizuj analizę danych w oparciu o: Inteligentne wykonanie   |  Wygeneruj kod  |  Twórz niestandardowe formuły  |  Analizuj dane i generuj wykresy  |  Wywołaj funkcje Kutools...
Popularne funkcje: Znajdź, wyróżnij lub zidentyfikuj duplikaty   |  Usuń puste wiersze   |  Łącz kolumny lub komórki bez utraty danych   |   Okrągły bez wzoru ...
Super wyszukiwanie: Wiele kryteriów VLookup    Wiele wartości VLookup  |   Przeglądanie pionowe na wielu arkuszach   |   Wyszukiwanie rozmyte ....
Zaawansowana lista rozwijana: Szybko twórz listę rozwijaną   |  Zależna lista rozwijana   |  Lista rozwijana wielokrotnego wyboru ....
Menedżer kolumn: Dodaj określoną liczbę kolumn  |  Przesuń kolumny  |  Przełącz stan widoczności ukrytych kolumn  |  Porównaj zakresy i kolumny ...
Polecane funkcje: Fokus siatki   |  Widok projektu   |   Duży pasek formuły    Menedżer skoroszytów i arkuszy   |  Biblioteka zasobów (Automatyczny tekst)   |  Selektor dat   |  Połącz arkusze   |  Szyfruj/odszyfruj komórki    Wysyłaj e-maile według listy   |  Super filtr   |   Specjalny filtr (filtruj pogrubienie/kursywa/przekreślenie...) ...
15 najlepszych zestawów narzędzi12 Tekst Tools (Dodaj tekst, Usuń znaki, ...)   |   50 + Wykres rodzaje (Wykres Gantta, ...)   |   40+ Praktyczne Wzory (Oblicz wiek na podstawie urodzin, ...)   |   19 Wprowadzenie Tools (Wstaw kod QR, Wstaw obraz ze ścieżki, ...)   |   12 Konwersja Tools (Liczby na słowa, Przeliczanie walut, ...)   |   7 Połącz i podziel Tools (Zaawansowane wiersze łączenia, Podział komórki, ...)   |   ... i więcej

Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas.  Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...

Opis


Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
Comments (127)
Rated 4.5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Anyone can help me, I have come a long way with this topic, but I am running into 1 problem. In cell J:Y, a formula produces a value for how long the project will last. This changes every day because the deadline is getting closer and closer. Now I want him to automatically send me an email when there are 14 days left. This works if I simply enter 14 here myself, but not if there is a formula in it. Who can help me to automatically recognize that the 14-day period has been reached based on the formula?
This comment was minimized by the moderator on the site
I want to apply this macro to different sheets in my workbook, but each sheet is different. Adding a second module means the first one no longer works.

Could you advise me please?
This comment was minimized by the moderator on the site
Hi Annie,

The code can be applied to different worksheets, not just the current one. After running the code, select the desired worksheet tab and then the cell range.
This comment was minimized by the moderator on the site
Olá, eu trabalho com calibrações de equipamentos controlados pelo inmetro, eu fiz uma planilha com a data de vencimento da calibração de cada equipamento, é possível quando a data estiver chegando próximo ao vencimento tipo uns 30 dias, o excel enviar um email automático para que eu possa lembrar?
This comment was minimized by the moderator on the site
Bonjour , je suis nouveau sur VBA

Comment faire pour quand les dates change ?
This comment was minimized by the moderator on the site
Hi theo charvet,

Sorry I don't quite understand your question. For clarity, please attach a screenshot with your data and desired results.
This comment was minimized by the moderator on the site
Hallo Zusammen,

ich möchte an die generierte Email immer die gleiche Datei anhägen.
Ist das irgendwie machbar? Ich bedanke mich recht herzlich vorab.

Hello all,

I would like to attach always the same file to the generated email.
Is this somehow possible? Thank you very much in advance.
This comment was minimized by the moderator on the site
Hi Sandro,

You need to add the following line above the .Display line in the VBA code.
Please replace the file path with the file path of your own.
.Attachments.Add "D:\Work\Month\Dec\Word.docx"
This comment was minimized by the moderator on the site
Hallo Zusammen,

danke für den Code.

Ich möchte an die generierte Email, immer den gleichen Anhang setzten. Mit meinem primitiven Versuch:

.attachments.add "Pfad\Dateiname" bin ich leider nicht weiter gekommen.

Kann mir hier vielleicht wer helfen? :)
This comment was minimized by the moderator on the site
Hi ,

I was using this and everything goes well but after step 5 I didn't see send button , please help. I need this very urgently.
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Hi Vani,
Does the new message window pop up? The Send button displays in the message window.
If there is no eligible date, the message will not be created.
This comment was minimized by the moderator on the site
Hi!
I am trialling and it seems that always need to open and run the module for the email to be created.
How do I automatically run this even if the worksheet is not open?
This comment was minimized by the moderator on the site
Hi Mychel,
Can you describe the problem more clearly? By the way, you can't run a macro if the workbook is not open.
This comment was minimized by the moderator on the site
Hi,

Can this code be amended where it will send two lines of information to one recipient? Say i have two due dates, rather than sending two emails to the same person, can they be merged into one?

Thanks
A
This comment was minimized by the moderator on the site
Hi,
Suppose there are two tasks are assiged to the same recipient. When the due dates of these two tasks meet the conditions, an email is generated that includes the corresponding information of the tasks in the email body. Please try the following VBA code. Hope I can help.

Public Sub CheckAndSendMail2()
'Updated by Extendoffice 2022/08/23
    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, xJ As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim xStrMail, xStrFind As String
    Dim xBol As Boolean
    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")
    xStrMail = ""
    For i = 1 To xLastRow
        xRgDateVal = ""
        xRgDateVal = xRgDate.Offset(i - 1).Value
        xBol = True
        If xRgDateVal <> "" Then
        If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
            xRgSendVal = xRgSend.Offset(i - 1).Value
            xStrFind = xRgSendVal & ";"
            If InStr(xStrMail, xStrFind) > 0 Then
                xBol = False
            End If
            If xBol Then
            xStrMail = xStrMail & xStrFind
            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
            For xJ = i + 1 To xLastRow
                If CDate(xRgDate.Offset(xJ - 1).Value) - Date <= 7 And CDate(xRgDate.Offset(xJ - 1).Value) - Date > 0 Then
                    If xRgSendVal = xRgSend.Offset(xJ - 1).Value Then
                        xMailBody = xMailBody & "Text : " & xRgText.Offset(xJ - 1).Value & vbCrLf
                    End If
                End If
            Next
            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
    End If
    Next
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Hello, I have an additional column. 'Subject' column with different subject for each mail. How do I add the Subject Loop in the above VBA Code?
This comment was minimized by the moderator on the site
Hi Pranay,
The following code can do you a favor. Please give it a try.
Public Sub CheckAndSendMail()
'Updated by Extendoffice 20220729
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgSubject 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 xRgSubject 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 xRgSubject = Application.InputBox("Please select the subject column:", "KuTools For Excel", , , , , , 8)
    If xRgSubject 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 xRgSubject = xRgSubject(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 = xRgSubject.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 Sub
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations