Note: The other languages of the website are Google-translated. Back to English

Як надіслати електронне повідомлення, якщо термін виконання досягнуто в Excel?

Як показано на знімку екрана нижче, якщо дата виконання в стовпці C менша або дорівнює 7 дням (наприклад, поточна дата – 2017/9/13), електронний лист надсилається вказаному одержувачу в стовпці A, а вказаний вміст у стовпці B відображається в тілі електронного листа. Як би ви могли цього досягти? У цій статті наведено код VBA, який допоможе вам виконати це завдання.

Надішліть електронне повідомлення, якщо термін виконання зазначений із кодом VBA


Надішліть електронне повідомлення, якщо термін виконання зазначений із кодом VBA

Будь ласка, виконайте наступні дії, щоб надіслати нагадування електронною поштою, якщо термін виконання досягнуто в Excel.

1 Натисніть кнопку інший + F11 клавіші одночасно, щоб відкрити Microsoft Visual Basic для додатків вікна.

2 В Microsoft Visual Basic для додатків вікно, натисніть Insert > Модулі. Потім скопіюйте та вставте наведений нижче код VBA у вікно модуля.

Код VBA: надішліть електронне повідомлення, якщо термін закінчення терміну закритий в 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

примітки: Лінія Якщо CDate (xRgDateVal) - Дата <= 7 і CDate (xRgDateVal) - Дата> 0 Тоді в коді VBA означає, що термін виконання повинен бути більше 1 дня і менше або дорівнювати 7 дням. Ви можете змінити його, як вам потрібно.

3. прес la Клавіша F5 для запуску коду. У першій вискакує Kutools для Excel діалоговому вікні, будь-ласка, виберіть діапазон стовпців дати, а потім натисніть OK кнопку. Дивіться знімок екрана:

4. Потім другий Kutools для Excel з'явиться діалогове вікно, виберіть відповідний діапазон стовпців, що містить адреси електронної пошти одержувачів, і натисніть на OK кнопку. Дивіться знімок екрана:

5. В останній Kutools для Excel діалоговому вікні, виберіть вміст, який ви хочете відображати в тілі електронної пошти, а потім клацніть на OK кнопки.

Тоді електронний лист буде автоматично створений із зазначеним одержувачем, темою та тілом, якщо термін подання у стовпці C менше або дорівнює 7 дням. Клацніть на Відправити , щоб надіслати електронне повідомлення.

примітки:

1. Кожен створений електронний лист відповідає терміну виконання. Наприклад, якщо три терміни виконання відповідають критеріям, три повідомлення електронної пошти будуть створені автоматично.

2. Цей код не буде спрацьовувати, якщо відсутні дати, що відповідають критеріям.

3. Код VBA працює лише тоді, коли ви використовуєте Outlook як програму електронної пошти.


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2021 і 365. Підтримує всі мови. Легке розгортання на вашому підприємстві чи в організації. 30-денна безкоштовна пробна версія повних функцій. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (118)
Оцінено 4.5 з 5 · рейтинги 1
Цей коментар був мінімізований модератором на сайті
Дякую, що поділились.


Як би ви додали копію чи кількох одержувачів?
Цей коментар був мінімізований модератором на сайті
Привіт, Брендон,

Вибачте за коментар до вашої публікації без відповіді, але чи змогли ви отримати код VBA, щоб надіслати електронний лист?
Цей коментар був мінімізований модератором на сайті
Я використовував ваш код VBA для надсилання електронних листів на основі значення клітинки, але він не працює.
Усе до кроку 5 працює, але електронна пошта не надсилається. Хтось може допомогти мені з цим?
Цей коментар був мінімізований модератором на сайті
Me viene muy bien gracias por el aporte, solo me falta como puedo hacerlo automaticamente sin necesidad de hacerlo manualmente el envio del correo.
Цей коментар був мінімізований модератором на сайті
Цей код заморозив мою програму Excel, коли я її запускав. Це інтенсивна пам’ять?
Цей коментар був мінімізований модератором на сайті
Привіт Роберт
Проблема, про яку ви згадали, не виникає в моєму випадку. Чи можу я отримати вашу версію Office?
Цей коментар був мінімізований модератором на сайті
чи можемо ми просто ввести деталі один раз, і електронні листи можуть надсилатися автоматично, замість того, щоб завжди вибирати стовпці?
Цей коментар був мінімізований модератором на сайті
Привіт Дія,
Якщо ви не хочете вибирати стовпці вручну, застосуйте наведений нижче код VBA.
Примітка. Після застосування коду вам потрібно лише вибрати стовпець термінів виконання.

Загальнодоступна субперевірка та надсилання пошти()
'Оновлено Extendoffice 2017/9/14
Dim xRgDate як діапазон
Dim xRgSend As Range
Dim xRgText як діапазон
Dim xRgDone As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xLastRow As Long
Dim vbCrLf як рядок
Заглушити xMailBody як рядок
Dim xRgDateVal як рядок
Dim xRgSendVal як рядок
Змінити xMailSubject як рядок
Dim I As Long
On Error Resume Next
Встановіть xRgDate = Application.InputBox("Виберіть стовпець терміну виконання:", "KuTools For Excel", , , , , , 8)
Якщо xRgDate — нічого, вийдіть із Sub
xLastRow = xRgDate.Rows.Count
Встановити xRgDate = xRgDate(1)
Встановити xRgSend = xRgSend(1)
Встановити xRgText = xRgText(1)
Встановіть xOutApp = CreateObject("Outlook.Application")
Для I = 1 до xLastRow
xRgDateVal = xRgDate.Offset(I - 1).Значення
Якщо CDate(xRgDateVal) - Дата <= 7 і CDate(xRgDateVal) - Дата > 0, то
xRgSendVal = xRgSend.Offset(I - 1).Значення
xMailSubject = xRgText.Offset(I - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = "Привіт" & vbNewLine & vbNewLine & _
"Це рядок 1" & vbNewLine & _
«Це рядок 2»
Встановити xMailItem = xOutApp.CreateItem(0)
За допомогою xMailItem
.To = "Адреса електронної пошти"
.CC = ""
.BCC = ""
.Subject = "відправити тестом значення комірки"
.Body = xMailBody
.Відобразити або використовувати .Send
Кінець з
Встановіть xMailItem = Нічого
End If
Далі
Встановіть xOutApp = Нічого
End Sub
Цей коментар був мінімізований модератором на сайті
Здравствуйте,
Я також майже новачок, і я хотів би поставити ще одне запитання для вашого чудового суб.

Як я можу надіслати електронний лист, лише якщо певна поштова адреса є у відповідній клітинці?

Мені це потрібно, тому що в моєму excel-інструменті я реалізував кілька кнопок для кожної людини, яка потребує нагадування.

Наперед Вам дякую!!

Томас
Цей коментар був мінімізований модератором на сайті
Привіт Томас,
Ми опублікували статтю "Як надіслати електронну пошту на електронні адреси, зазначені в клітинках Excel?"
https://www.extendoffice.com/documents/excel/4717-excel-macro-send-email-to-address-in-cells.html
Можливо, ви знайдете своє рішення в цій статті.
Цей коментар був мінімізований модератором на сайті
Мені це потрібно, щоб працювати з усіма аркушами в книзі, майбутня дата буде вручну введена в ту саму клітинку на кожному аркуші, а нові аркуші створюватимуться щодня. Мені також потрібна назва робочого аркуша в електронному листі, щоб я знав, який аркуш потрібно отримати
Цей коментар був мінімізований модератором на сайті
На жаль, я не можу вам з цим допомогти.
Ласкаво просимо опублікувати будь-які запитання щодо Excel на нашому форумі: https://www.extendoffice.com/forum.html. Ви отримаєте більше підтримки Excel від наших професіоналів або інших шанувальників Excel.
Цей коментар був мінімізований модератором на сайті
Не змусьте це працювати. Використовуючи Office 365, тому Outlook і Excel повинні бути досить щільними. Як і в дописі від "schou" 4 місяці тому, він працює до кроку 5, але потім нічого.
Рішення цього?
Цей коментар був мінімізований модератором на сайті
У мене є Excel для надсилання електронного листа, але чи можу я встановити це так, щоб він надсилав електронний лист щоразу, коли я відкриваю Excel, замість того, щоб щоразу вибирати стовпці.

У мене є робоча книга з 24 сторінками, тому я хочу автоматично надсилати електронною поштою, коли книга відкривається.


Велике спасибі.
Цей коментар був мінімізований модератором на сайті
привіт,
Ви маєте на увазі автоматично перевіряти термін виконання в книзі та надсилати електронний лист, коли книга відкривається?
Цей коментар був мінімізований модератором на сайті
Привіт, народ,


Макрос — це чудово, але я хотів би дещо запитати — якщо у вас є хтось у списку без жодної дати, як змінити код vba, щоб виключити цього хлопця? Тепер код генерує електронні листи навіть для хлопців без дати.


Спасибо!
Цей коментар був мінімізований модератором на сайті
Привіт, Львів
Код було оновлено з вирішенням проблеми, будь ласка, спробуйте. Дякуємо за коментар.
Цей коментар був мінімізований модератором на сайті
Привіт, Пошта автоматично генерує стовпці з пустими даними. Я також хотів би мати оновлений код.
Цей коментар був мінімізований модератором на сайті
Дуже дякую за внесок. Я хотів би знати, як використовувати фіксований вибір стовпців без використання kutools? тобто залишити за замовчуванням стовпці з датами, квитанціями та попередженнями?
Цей коментар був мінімізований модератором на сайті
Добрий день,
Наведений нижче код VBA може допомогти вам. Будь ласка, спробуйте.

Загальнодоступна субперевірка та надсилання пошти()
'Оновлено Extendoffice 2018/11/22
Dim xRgDate як діапазон
Dim xRgSend As Range
Dim xRgText як діапазон
Dim xRgDone As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xLastRow As Long
Dim vbCrLf як рядок
Заглушити xMailBody як рядок
Dim xRgDateVal як рядок
Dim xRgSendVal як рядок
Змінити xMailSubject як рядок
Dim i As Long
On Error Resume Next
Встановити xRgDate = Range("C2:C4") 'Будь ласка, посилайтеся на стовпець терміну виконання
Якщо xRgDate — нічого, вийдіть із Sub
Встановіть xRgSend = Range("A2:A4") 'Будь ласка, посилайтеся на стовпець електронної пошти одержувачів
Якщо xRgSend — нічого, вийдіть із Sub
Встановіть xRgText = Range("B2:B4") Введіть стовпець із нагадуваним вмістом у вашій електронній пошті
Якщо xRgText — це нічого, вийдіть із Sub
xLastRow = xRgDate.Rows.count
Встановити xRgDate = xRgDate(1)
Встановити xRgSend = xRgSend(1)
Встановити xRgText = xRgText(1)
Встановіть xOutApp = CreateObject("Outlook.Application")
Для i = 1 До xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Значення
Якщо xRgDateVal <> "" Тоді
Якщо CDate(xRgDateVal) - Дата <= 7 і CDate(xRgDateVal) - Дата > 0, то
xRgSendVal = xRgSend.Offset(i - 1).Значення
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Встановити xMailItem = xOutApp.CreateItem(0)
За допомогою xMailItem
.Тема = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
Відображення
'.Надіслати
Кінець з
Встановіть xMailItem = Нічого
End If
End If
Далі
Встановіть xOutApp = Нічого
End Sub
Цей коментар був мінімізований модератором на сайті
Шановний Crytal,

Дякую, що поділилися.

Я новачок і маю проблему з кодом.

xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""

Текст не переходить на новий рядок.
Не могли б ви допомогти.

Дякую
Цей коментар був мінімізований модератором на сайті
ні ніні,
Вам потрібно додати рядок vbCrLf = " «перед холодами.
Такі як:
vbCrLf = " "
xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Цей коментар був мінімізований модератором на сайті
Шановний Crystal, під час вибору стовпця дат, чи можна вибрати кілька клітинок у різних стовпцях?
Цей коментар був мінімізований модератором на сайті
Здравствуйте,
Пане Кристал, у вашій останній розмові з паном Іваном він попросив у вас код, щоб надсилати електронною поштою щоразу, коли відкривається електронна таблиця, а не щоразу вводити коди.
Мені потрібен той самий код, та сама ситуація, чи можете ви допомогти?
Цей коментар був мінімізований модератором на сайті
Правильно, не з паном Іваном, а з містером Остіном.
Дякую.
Цей коментар був мінімізований модератором на сайті
Привіт, я використовую модифіковану версію цього коду, і я досить новачок у VBA. Мені було цікаво, чи існує можливість для того, коли електронний лист буде надіслано, макрос зможе позначити X, або якщо хтось має Complete, електронний лист не буде надіслано. Я сподіваюся, що все це має сенс. Будь-яка допомога дуже цінується.

Невелика інформація, я використовую цей інструмент, щоб запустити перевірку терміну на 30, 60 днів і прострочений термін. Я хочу, щоб 1 електронний лист надійшов через 30 днів, 1 – через 60 днів, а потім також прострочено. Я запускаю це зі сценарію VB, який я написав, щоб я міг автоматизувати його щодня. Спасибі!
Цей коментар був мінімізований модератором на сайті
Привіт, я використовую модифіковану версію цього коду, і я досить новачок у VBA. Мені було цікаво, чи існує можливість для того, коли електронний лист буде надіслано, макрос зможе позначити X, або якщо хтось має Complete, електронний лист не буде надіслано. Я сподіваюся, що все це має сенс. Будь-яка допомога дуже цінується. Невелика інформація, я використовую цей інструмент, щоб запустити перевірку терміну на 30, 60 днів і прострочений термін. Я хочу, щоб 1 електронний лист надійшов через 30 днів, 1 – через 60 днів, а потім також прострочено. Я запускаю це зі сценарію VB, який я написав, щоб я міг автоматизувати його щодня. Спасибі!
Цей коментар був мінімізований модератором на сайті
Вітаю, сер,

Це дуже корисно. Мені потрібно ще 2 покращення в тих самих кодах. Мені потрібно щоразу натискати кнопку «Надіслати». Це нормально, якщо у мене є 10 електронних листів, які потрібно надіслати, а якщо я буду надіслати більше 25 листів за один день. Тому, будь ласка, надайте мені код для автоматичного надсилання електронної пошти, вибравши термін, одержувач, тему тощо.

Також, будь ласка, надайте мені код, щоб додати опцію "CC".


Дякую

Ехолот П
Цей коментар був мінімізований модератором на сайті
Добрий день,
Будь ласка, спробуйте наведений нижче код VBA, сподіваюся, що зможу допомогти. Дякую за коментар.

Загальнодоступна субперевірка та надсилання пошти()
'Оновлено Extendoffice 2018/11/22
Dim xRgDate як діапазон
Dim xRgSend As Range
Dim xRgText як діапазон
Dim xRgDone As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xLastRow As Long
Dim vbCrLf як рядок
Заглушити xMailBody як рядок
Dim xRgDateVal як рядок
Dim xRgSendVal як рядок
Змінити xMailSubject як рядок
Dim i As Long
On Error Resume Next
Встановіть xRgDate = Application.InputBox("Виберіть стовпець терміну виконання:", "KuTools For Excel", , , , , , 8)
Якщо xRgDate — нічого, вийдіть із Sub
Встановіть xRgSend = Application.InputBox("Виберіть стовпець одержувачів? електронної пошти:", "KuTools For Excel", , , , , , 8)
Якщо xRgSend — нічого, вийдіть із Sub
Встановіть xRgCC = Application.InputBox("Виберіть, будь ласка, одержувачів CC? стовпець електронної пошти:", "KuTools For Excel", , , , , , 8)
Якщо xRgCC — нічого, вийдіть із Sub
Встановіть xRgText = Application.InputBox("Виберіть стовпець із нагадуваним вмістом у вашій електронній пошті:", "KuTools For Excel", , , , , , 8)
Якщо xRgText — це нічого, вийдіть із Sub
xLastRow = xRgDate.Rows.Count
Встановити xRgDate = xRgDate(1)
Встановити xRgSend = xRgSend(1)
Встановити xRgCC = xRgCC(1)
Встановити xRgText = xRgText(1)
Встановіть xOutApp = CreateObject("Outlook.Application")
Для i = 1 До xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Значення
Якщо xRgDateVal <> "" Тоді
Якщо CDate(xRgDateVal) - Дата <= 7 і CDate(xRgDateVal) - Дата > 0, то
xRgSendVal = xRgSend.Offset(i - 1).Значення
xRgCCVal = xRgCC.Зсув(i - 1).Значення
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Встановити xMailItem = xOutApp.CreateItem(0)
За допомогою xMailItem
.Тема = xMailSubject
.To = xRgSendVal
.Cc = xRgCCVal
.HTMLBody = xMailBody
.Надіслати
Кінець з
Встановіть xMailItem = Нічого
End If
End If
Далі
Встановіть xOutApp = Нічого
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

Дякую за коди, оскільки вони дуже корисні. Але як змусити код працювати, якщо я використовую outlook.office.com?
Цей коментар був мінімізований модератором на сайті
у тілі я хочу, щоб значення стовпця a,b,c було у форматі таблиці, наприклад, дата закінчення терміну дії після досягнення в стовпці тіла я хочу надрукувати деталі клітинок a,b,c у форматі таблиці
Цей коментар був мінімізований модератором на сайті
Привіт, Dinesh BS!
Вибачте, не можу вам з цим допомогти. Ласкаво просимо опублікувати будь-які запитання на нашому форумі: https://www.extendoffice.com/forum.html.
Цей коментар був мінімізований модератором на сайті
Привіт, я новачок у VBA. Чи є спосіб, щоб ця програма автоматично запускалася щоразу, коли відкривається файл?
Цей коментар був мінімізований модератором на сайті
Привіт, L Echols!
Для автоматичного запуску коду під час відкриття файлу двічі клацніть, щоб відкрити вікно коду ThisWorkbook (знаходиться в лівій частині вікна Microsoft Visual Basic for Applications), виберіть Workbook у першому спадному списку, а потім скопіюйте вище коду VBA (крім першого та останнього рядків) у вікно коду та вставте між цими двома рядками. Дивіться прикріплений нижче знімок екрана:
Цей коментар був мінімізований модератором на сайті
Це круто. Мені було цікаво, чи є спосіб запустити код без необхідності щоразу вибирати значення KuTools? Для уточнення я ввів цей код, і тепер, коли я відкриваю книгу, мені все одно потрібно виділяти ті самі стовпці. Чи є спосіб ввести код, щоб запускати перевірку в тих самих стовпцях щоразу - доки не було внесено жодних змін до книги - щоб запустити перевірку та сформулювати електронний лист на основі зазначеної перевірки? Спасибі заздалегідь.
Цей коментар був мінімізований модератором на сайті
Привіт, Денні,
Спробуйте наведений нижче код і змініть діапазони, як вам потрібно.

Загальнодоступна субперевірка та надсилання пошти()
'Оновлено Extendoffice 2019/5/17
Dim xRgDate як діапазон
Dim xRgSend As Range
Dim xRgText як діапазон
Dim xRgDone As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xLastRow As Long
Dim vbCrLf як рядок
Заглушити xMailBody як рядок
Dim xRgDateVal як рядок
Dim xRgSendVal як рядок
Змінити xMailSubject як рядок
Dim i As Long
On Error Resume Next
Встановити xRgDate = діапазон ("C2: C4")
Якщо xRgDate — нічого, вийдіть із Sub
Встановіть xRgSend = діапазон ("A2: A4")
Якщо xRgSend — нічого, вийдіть із Sub
Встановити xRgText = діапазон ("B2:B4")
Якщо xRgText — це нічого, вийдіть із Sub
xLastRow = xRgDate.Rows.Count
Встановити xRgDate = xRgDate(1)
Встановити xRgSend = xRgSend(1)
Встановити xRgText = xRgText(1)
Встановіть xOutApp = CreateObject("Outlook.Application")
Для i = 1 До xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Значення
Якщо xRgDateVal <> "" Тоді
Якщо CDate(xRgDateVal) - Дата <= 7 і CDate(xRgDateVal) - Дата > 0, то
xRgSendVal = xRgSend.Offset(i - 1).Значення
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Встановити xMailItem = xOutApp.CreateItem(0)
За допомогою xMailItem
.Тема = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
Відображення
'.Надіслати
Кінець з
Встановіть xMailItem = Нічого
End If
End If
Далі
Встановіть xOutApp = Нічого
End Sub
Цей коментар був мінімізований модератором на сайті
Це круто. Мені було цікаво, чи є спосіб запустити код без необхідності щоразу вибирати значення KuTools? Для уточнення я ввів цей код, і тепер, коли я відкриваю книгу, мені все одно потрібно виділяти ті самі стовпці. Чи є спосіб ввести код, щоб запускати перевірку в тих самих стовпцях щоразу - доки не було внесено жодних змін до книги - щоб запустити перевірку та сформулювати електронний лист на основі зазначеної перевірки? Спасибі заздалегідь.
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,
У мене виникла проблема з автоматичним надсиланням електронної пошти після відкриття файлу. Наприклад, у мене є вся інформація про термін виконання на листі 1. Однак, якщо я збережу та закрию файл під час роботи над Sheet2, щойно я відкрию файл, значення для надсилання електронних листів будуть засновані на Sheet2, а не на Sheet1. Я додав лише модуль на Sheet1 та ThisWorkbook. Я думаю, що наявність того самого vba на ThisWorkbook запускає автоматичне надсилання електронних листів на будь-який аркуш, який у мене зараз відкритий. Як я можу обмежити VBA витягувати значення з певного аркуша, а також надсилати електронні листи, коли файл відкривається? Дуже дякую за допомогу наперед!
Цей коментар був мінімізований модератором на сайті
Я новачок у VBA. Чи є спосіб автоматично запускати цю програму щоразу, коли відкривається файл?
Цей коментар був мінімізований модератором на сайті
Так, с


Приватна додаткова робоча книга_Open()
*Введіть код тут*
End Sub
Цей коментар був мінімізований модератором на сайті
привіт,

У мене є питання,

Якщо я хочу вибрати попередньо визначений діапазон комірок, як я можу змінити код у цій частині:

xLastRow = xRgDate.Rows.Count
Встановити xRgDate = xRgDate(1)

Автоматично встановити клітинки?

Дякую :)
Цей коментар був мінімізований модератором на сайті
привіт,
Якщо ви не хочете щоразу вибирати діапазони вручну під час застосування коду, скористайтеся наведеним нижче кодом.

Загальнодоступна субперевірка та надсилання пошти()
'Оновлено Extendoffice 2019/12/10
Dim xRgDate як діапазон
Dim xRgSend As Range
Dim xRgText як діапазон
Dim xRgDone As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xLastRow As Long
Dim vbCrLf як рядок
Заглушити xMailBody як рядок
Dim xRgDateVal як рядок
Dim xRgSendVal як рядок
Змінити xMailSubject як рядок
Dim i As Long
On Error Resume Next
Встановити xRgDate = діапазон ("C2: C4")
Якщо xRgDate — нічого, вийдіть із Sub
Встановіть xRgSend = діапазон ("A2: A4")
Якщо xRgSend — нічого, вийдіть із Sub
Встановити xRgText = діапазон ("B2:B4")
Якщо xRgText — це нічого, вийдіть із Sub
xLastRow = xRgDate.Rows.Count
Встановити xRgDate = xRgDate(1)
Встановити xRgSend = xRgSend(1)
Встановити xRgText = xRgText(1)
Встановіть xOutApp = CreateObject("Outlook.Application")
Для i = 1 До xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Значення
Якщо xRgDateVal <> "" Тоді
Якщо CDate(xRgDateVal) - Дата <= 7 і CDate(xRgDateVal) - Дата > 0, то
xRgSendVal = xRgSend.Offset(i - 1).Значення
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Дорогий " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Встановити xMailItem = xOutApp.CreateItem(0)
За допомогою xMailItem
.Тема = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
Відображення
'.Надіслати
Кінець з
Встановіть xMailItem = Нічого
End If
End If
Далі
Встановіть xOutApp = Нічого
End Sub
Цей коментар був мінімізований модератором на сайті
Буенос Діас! ¿que modificación tendría que realizar para dejar seleccionadas las celdas con la información de fecha, texto y correo y no tener que seleccionarlas cada vez que se activa la macro?

también me gustaría sabre como introducir un CC, es decir, poder poner a otra persona en copia del correo. Дякую!
Цей коментар був мінімізований модератором на сайті
Привіт! Pudiste solucionar esto? Estoy necesitando lo mismo.. gracias!
There are no comments posted here yet
Load More
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL