Автоматическая отправка почты с пoмощью макроса
Jotung13
Дата: Понедельник, 08.10.2018, 15:33 |
Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация:
0
±
Замечаний:
0% ±
Excel 2010
Добрый день. Требуется отправлять автоматом сообщение на указанные в таблице мейлы, когда наступает дата из другого столбца этой же таблицы. Удалось найти скрипт, который просто отправляет мейлы независимо от даты. Условие проверки, к сожалению, вставить не получается - выходит type mismatch. [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba]
Добрый день. Требуется отправлять автоматом сообщение на указанные в таблице мейлы, когда наступает дата из другого столбца этой же таблицы. Удалось найти скрипт, который просто отправляет мейлы независимо от даты. Условие проверки, к сожалению, вставить не получается - выходит type mismatch. [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba] Jotung13
Сообщение отредактировал Jotung13 - Понедельник, 08.10.2018, 16:20
Ответить
Сообщение Добрый день. Требуется отправлять автоматом сообщение на указанные в таблице мейлы, когда наступает дата из другого столбца этой же таблицы. Удалось найти скрипт, который просто отправляет мейлы независимо от даты. Условие проверки, к сожалению, вставить не получается - выходит type mismatch. [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba] Автор - Jotung13 Дата добавления - 08.10.2018 в 15:33
Pelena
Дата: Понедельник, 08.10.2018, 18:54 |
Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация:
4554
±
Замечаний:
±
Excel 365 & Mac Excel
из другого столбца этой же таблицы
Из какого именно? Проверить не на чем, если дата сразу после адреса, то может так [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) If Cells(iCounter, 13).Value=Date then Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing End If Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba] Это если Вы каждый день запускаете макрос
из другого столбца этой же таблицы
Из какого именно? Проверить не на чем, если дата сразу после адреса, то может так [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) If Cells(iCounter, 13).Value=Date then Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing End If Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba] Это если Вы каждый день запускаете макросPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Ответить
Сообщение из другого столбца этой же таблицы
Из какого именно? Проверить не на чем, если дата сразу после адреса, то может так [vba]Код
Sub send_email() Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String strSubj = "Просьба предоставить заполненный SMS request" On Error GoTo dbg Set olApp = CreateObject("Outlook.Application") For iCounter = 1 To WorksheetFunction.CountA(Columns(12)) If Cells(iCounter, 13).Value=Date then Set olMailItm = olApp.CreateItem(0) strBody = "" useremail = Cells(iCounter, 12).Value FullUsername = Cells(iCounter, 7).Value ProjectName = Cells(iCounter, 1).Value strBody = "Уважаемый " & FullUsername & vbCrLf strBody = strBody & "Напоминаем Вам о заявленном ранее проекте - " & ProjectName & vbCrLf olMailItm.To = useremail olMailItm.Subject = strSubj olMailItm.BodyFormat = 1 olMailItm.Body = strBody olMailItm.Send Set olMailItm = Nothing End If Next iCounter Set olApp = Nothing dbg: If Err.Description <> "" Then MsgBox Err.Description End Sub
[/vba] Это если Вы каждый день запускаете макросАвтор - Pelena Дата добавления - 08.10.2018 в 18:54
Jotung13
Дата: Среда, 10.10.2018, 10:49 |
Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация:
0
±
Замечаний:
0% ±
Excel 2010
Да, это макрос на каждый день. Благодарю - работает, как ожидалось.
Да, это макрос на каждый день. Благодарю - работает, как ожидалось. Jotung13
Ответить
Сообщение Да, это макрос на каждый день. Благодарю - работает, как ожидалось. Автор - Jotung13 Дата добавления - 10.10.2018 в 10:49