Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Рассылка писем через Outlook - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Рассылка писем через Outlook (Макросы/Sub)
Рассылка писем через Outlook
Sergey21 Дата: Четверг, 15.11.2018, 08:13 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день, нашел макрос в интернете по рассылке писем через Outlook, помогите его доработать, нужно добавить возможность вставлять вложения в каждое письмо из рассылки, адрес вложения будет на против каждого получателя в ячейке столбца "F", но тут еще такое условие, файлов в папке будет много и конкретного пути для каждого файла нет, из-за того, что почти все имя файла будет изменяться каждый раз при выгрузке его из программы 1С, но в имени файла есть часть, которая меняться не будет, т.е. пример наименования файла: "Табель_часть, которая всегда меняется_Отдел такой-то.xls"
Помогите доработать макрос (файл пример, прилагаю)
[vba]
Код

Sub dsf()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
' тема письма
strSubj = "Табель аванс"
On Error GoTo dbg
' создаем новый объект типа Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
Copy = Cells(iCounter, 2).Value
FullUsername = Cells(iCounter, 3).Value
Status = Cells(iCounter, 5).Value
pwdchange = Cells(iCounter, 4).Value
'формируем тело письма
strBody = "Добрый день! " & vbCrLf
strBody = strBody & "Высылаю Вам сформированный 1С табель учета рабочего времени заполненный " & Status & vbCrLf
strBody = strBody & "Проверьте этот табель на достоверность, если все верно подпишите последний лист и пришлите скан-копию вместе с электронной версией табеля на мой электронный адрес " & vbCrLf
strBody = strBody & "Если необходимо внести изменения - вносите изменения прямо в этом же файле. " & vbCrLf
strBody = strBody & "Важно: " & vbCrLf
strBody = strBody & "1.  Новые строки добавлять нельзя " & vbCrLf
strBody = strBody & "2.  Объединять ячейки нельзя " & vbCrLf
strBody = strBody & "3.  Удалять табельные номера сотрудников нельзя " & vbCrLf
strBody = strBody & "4.  Менять название файла нельзя " & vbCrLf
strBody = strBody & "Можно менять все что касается графика и табеля работы сотрудников, а также обозначения на полях (неявки на работу, командировки, изменение графика и др.)" & vbCrLf
strBody = strBody & "Сканы проверенных и подписанных табелей необходимо предоставить " & FullUsername & ", оригиналы необходимо передать " & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.CC = Copy
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 2
' 1 - текстовый формат письма, 2 -* HTML формат
olMailItm.Body = strBody
olMailItm.Send
'следующую строку можно использовать для отладки текста письма, закомментировав предыдущую
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'отображение ошибок, если есть
If Err.Description <> "" Then MsgBox Err.Description
End Sub
[/vba]
К сообщению приложен файл: -_-.xlsm(18.3 Kb)


Сообщение отредактировал Sergey21 - Четверг, 15.11.2018, 08:29
 
Ответить
СообщениеДобрый день, нашел макрос в интернете по рассылке писем через Outlook, помогите его доработать, нужно добавить возможность вставлять вложения в каждое письмо из рассылки, адрес вложения будет на против каждого получателя в ячейке столбца "F", но тут еще такое условие, файлов в папке будет много и конкретного пути для каждого файла нет, из-за того, что почти все имя файла будет изменяться каждый раз при выгрузке его из программы 1С, но в имени файла есть часть, которая меняться не будет, т.е. пример наименования файла: "Табель_часть, которая всегда меняется_Отдел такой-то.xls"
Помогите доработать макрос (файл пример, прилагаю)
[vba]
Код

Sub dsf()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
' тема письма
strSubj = "Табель аванс"
On Error GoTo dbg
' создаем новый объект типа Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
Copy = Cells(iCounter, 2).Value
FullUsername = Cells(iCounter, 3).Value
Status = Cells(iCounter, 5).Value
pwdchange = Cells(iCounter, 4).Value
'формируем тело письма
strBody = "Добрый день! " & vbCrLf
strBody = strBody & "Высылаю Вам сформированный 1С табель учета рабочего времени заполненный " & Status & vbCrLf
strBody = strBody & "Проверьте этот табель на достоверность, если все верно подпишите последний лист и пришлите скан-копию вместе с электронной версией табеля на мой электронный адрес " & vbCrLf
strBody = strBody & "Если необходимо внести изменения - вносите изменения прямо в этом же файле. " & vbCrLf
strBody = strBody & "Важно: " & vbCrLf
strBody = strBody & "1.  Новые строки добавлять нельзя " & vbCrLf
strBody = strBody & "2.  Объединять ячейки нельзя " & vbCrLf
strBody = strBody & "3.  Удалять табельные номера сотрудников нельзя " & vbCrLf
strBody = strBody & "4.  Менять название файла нельзя " & vbCrLf
strBody = strBody & "Можно менять все что касается графика и табеля работы сотрудников, а также обозначения на полях (неявки на работу, командировки, изменение графика и др.)" & vbCrLf
strBody = strBody & "Сканы проверенных и подписанных табелей необходимо предоставить " & FullUsername & ", оригиналы необходимо передать " & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.CC = Copy
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 2
' 1 - текстовый формат письма, 2 -* HTML формат
olMailItm.Body = strBody
olMailItm.Send
'следующую строку можно использовать для отладки текста письма, закомментировав предыдущую
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'отображение ошибок, если есть
If Err.Description <> "" Then MsgBox Err.Description
End Sub
[/vba]

Автор - Sergey21
Дата добавления - 15.11.2018 в 08:13
китин Дата: Четверг, 15.11.2018, 08:15 | Сообщение № 2
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5155
Репутация: 817 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
Sergey21, код надо вставлять не под спойлер а в тэги
пояснялка здесь
и файл не приложился


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеSergey21, код надо вставлять не под спойлер а в тэги
пояснялка здесь
и файл не приложился

Автор - китин
Дата добавления - 15.11.2018 в 08:15
Sergey21 Дата: Четверг, 15.11.2018, 08:31 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Вот, вроде все отредактировал, но все равно как-то все не красиво получается
 
Ответить
СообщениеВот, вроде все отредактировал, но все равно как-то все не красиво получается

Автор - Sergey21
Дата добавления - 15.11.2018 в 08:31
Pelena Дата: Четверг, 15.11.2018, 08:54 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 13311
Репутация: 2931 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Для кодов надо использовать кнопку #, а не fx


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеДля кодов надо использовать кнопку #, а не fx

Автор - Pelena
Дата добавления - 15.11.2018 в 08:54
Pelena Дата: Четверг, 15.11.2018, 09:09 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 13311
Репутация: 2931 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Не совсем понятно, в чём проблема. Считать адрес файла из ячейки и добавить в код строчку olMailItm.Attachments.Add путь? Или проблема в формировании имени файла?


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеНе совсем понятно, в чём проблема. Считать адрес файла из ячейки и добавить в код строчку olMailItm.Attachments.Add путь? Или проблема в формировании имени файла?

Автор - Pelena
Дата добавления - 15.11.2018 в 09:09
Sergey21 Дата: Четверг, 15.11.2018, 09:36 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Да, проблема в том, что часть имени файла будет всегда меняться, как я написал в примере:
Табель_часть, которая всегда меняется_Отдел такой-то.xls
Поэтому точный путь не могу указать
 
Ответить
СообщениеPelena, Да, проблема в том, что часть имени файла будет всегда меняться, как я написал в примере:
Табель_часть, которая всегда меняется_Отдел такой-то.xls
Поэтому точный путь не могу указать

Автор - Sergey21
Дата добавления - 15.11.2018 в 09:36
Pelena Дата: Четверг, 15.11.2018, 09:46 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 13311
Репутация: 2931 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Тогда нужен алгоритм, как определять изменяемую часть имени файла


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеТогда нужен алгоритм, как определять изменяемую часть имени файла

Автор - Pelena
Дата добавления - 15.11.2018 в 09:46
Sergey21 Дата: Четверг, 15.11.2018, 09:58 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Ну например предположить, что изменяемая часть будет находиться между символами "_", в наименовании файла.
 
Ответить
СообщениеPelena, Ну например предположить, что изменяемая часть будет находиться между символами "_", в наименовании файла.

Автор - Sergey21
Дата добавления - 15.11.2018 в 09:58
Pelena Дата: Четверг, 15.11.2018, 11:42 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 13311
Репутация: 2931 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Я, наверное, плохо объясняю. После выгрузки новых файлов из 1С Вы хотите, чтобы Excel сам догадался, что на что поменять в столбце F? Или всё же есть какое-правило?
Вытянуть часть имени между символами _ не проблема, а дальше что делать?


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЯ, наверное, плохо объясняю. После выгрузки новых файлов из 1С Вы хотите, чтобы Excel сам догадался, что на что поменять в столбце F? Или всё же есть какое-правило?
Вытянуть часть имени между символами _ не проблема, а дальше что делать?

Автор - Pelena
Дата добавления - 15.11.2018 в 11:42
Sergey21 Дата: Четверг, 15.11.2018, 12:48 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Алгоритм действий будет такой:
1. Из 1С в определенную папку будут выгружаться файлы с именем Табель_часть, которая всегда меняется_Отдел кадров.xls, Табель_часть, которая всегда меняется_Бухгалтерия.xls и т.д.
2. При запуске макроса, должно сформироваться письмо для каждого получателя указанного в столбце "A", с вложением для каждого получателя свое вложение.
В столбце F нужно как-то прописать путь, чтобы в приложение к каждому письму прицеплялся файл соответствующего отдела. Т.е. например в ячейке A1 будет адрес электронной почты отдела кадров, в ячейке A2 адрес электронной почты Бухгалтерии и т.д., таким образом файл Табель_часть, которая всегда меняется_Отдел кадров.xls, Табель_часть, которая всегда меняется_Бухгалтерия.xls и т.д., должен быть подцеплен для каждого отдела свой.
 
Ответить
СообщениеPelena, Алгоритм действий будет такой:
1. Из 1С в определенную папку будут выгружаться файлы с именем Табель_часть, которая всегда меняется_Отдел кадров.xls, Табель_часть, которая всегда меняется_Бухгалтерия.xls и т.д.
2. При запуске макроса, должно сформироваться письмо для каждого получателя указанного в столбце "A", с вложением для каждого получателя свое вложение.
В столбце F нужно как-то прописать путь, чтобы в приложение к каждому письму прицеплялся файл соответствующего отдела. Т.е. например в ячейке A1 будет адрес электронной почты отдела кадров, в ячейке A2 адрес электронной почты Бухгалтерии и т.д., таким образом файл Табель_часть, которая всегда меняется_Отдел кадров.xls, Табель_часть, которая всегда меняется_Бухгалтерия.xls и т.д., должен быть подцеплен для каждого отдела свой.

Автор - Sergey21
Дата добавления - 15.11.2018 в 12:48
Sancho Дата: Четверг, 15.11.2018, 13:35 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 240
Репутация: 13 ±
Замечаний: 0% ±

2007, 2010, 2013
Не думаю что емайлы адресатов будут содержать "Бухгалтерия" или "Отдел кадров" поэтому алгоритм такой:
1. добавить столбец с названиями отделов в строку к соответствующему емайл, т.е привязать к емайлу наименование отдела. названия отделов должны быть полностью идентичны неизменяемой части наименования отдела в именах файлов (в т.ч. заглавные прописные)
2. циклом перебирать файлы в папке (файлы то в одной папке?) и добавлять в письмо если название файла содержит соответствующее название отдела.

Как то так
[vba]
Код
Sub dsf()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim myFile As String
Dim myPath As String
Dim FileAdd As String
myPath = "D:\TEMP\"

' тема письма
strSubj = "Табель аванс"
On Error GoTo dbg
' создаем новый объект типа Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
Copy = Cells(iCounter, 2).Value
FullUsername = Cells(iCounter, 3).Value
Status = Cells(iCounter, 5).Value
pwdchange = Cells(iCounter, 4).Value
'формируем тело письма
strBody = "Добрый день! " & vbCrLf
strBody = strBody & "Высылаю Вам сформированный 1С табель учета рабочего времени заполненный " & Status & vbCrLf
strBody = strBody & "Проверьте этот табель на достоверность, если все верно подпишите последний лист и пришлите скан-копию вместе с электронной версией табеля на мой электронный адрес и в адрес куратора в отделе подбора и кадрового администрирования для согласования (куратора уточняйте у Сафоновой Н.У.) " & vbCrLf
strBody = strBody & "Если необходимо внести изменения - вносите изменения прямо в этом же файле. " & vbCrLf
strBody = strBody & "Важно: " & vbCrLf
strBody = strBody & "1.  Новые строки добавлять нельзя " & vbCrLf
strBody = strBody & "2.  Объединять ячейки нельзя " & vbCrLf
strBody = strBody & "3.  Удалять табельные номера сотрудников нельзя " & vbCrLf
strBody = strBody & "4.  Менять название файла нельзя " & vbCrLf
strBody = strBody & "Можно менять все что касается графика и табеля работы сотрудников, а также обозначения на полях (неявки на работу, командировки, изменение графика и др.)" & vbCrLf
strBody = strBody & "Сканы проверенных и подписанных табелей необходимо предоставить " & FullUsername & ", оригиналы необходимо передать " & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.CC = Copy
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 2
' 1 - текстовый формат письма, 2 -  HTML формат

myFile = Cells(iCounter, 6).Value
FileAdd = Dir(myPath & "*.*")
Do While FileAdd <> ""
    If FileAdd Like ("*" & myFile & ".*") Then
        olMailItm.Attachments.Add myPath & FileAdd
    End If
    FileAdd = Dir
Loop

olMailItm.Body = strBody
olMailItm.Display 'Send
'следующую строку можно использовать для отладки текста письма, закомментировав предыдущую
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'отображение ошибок, если есть
If Err.Description <> "" Then MsgBox Err.Description
End Sub
[/vba]

замените строку [vba]
Код
myPath = "D:\TEMP\"
[/vba] на свой путь, или вообще заменить её на диалоговое окно выбора нужной папки (но это уже другая история)

строка [vba]
Код
olMailItm.Display 'Send
[/vba] переключена на отображение окна сообщения, что бы проверить всё ли правильно сформировалось. если ошибок нет то удалите Display '
К сообщению приложен файл: AddFile.xlsm(19.7 Kb)


Сообщение отредактировал Sancho - Четверг, 15.11.2018, 15:19
 
Ответить
СообщениеНе думаю что емайлы адресатов будут содержать "Бухгалтерия" или "Отдел кадров" поэтому алгоритм такой:
1. добавить столбец с названиями отделов в строку к соответствующему емайл, т.е привязать к емайлу наименование отдела. названия отделов должны быть полностью идентичны неизменяемой части наименования отдела в именах файлов (в т.ч. заглавные прописные)
2. циклом перебирать файлы в папке (файлы то в одной папке?) и добавлять в письмо если название файла содержит соответствующее название отдела.

Как то так
[vba]
Код
Sub dsf()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim myFile As String
Dim myPath As String
Dim FileAdd As String
myPath = "D:\TEMP\"

' тема письма
strSubj = "Табель аванс"
On Error GoTo dbg
' создаем новый объект типа Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
Copy = Cells(iCounter, 2).Value
FullUsername = Cells(iCounter, 3).Value
Status = Cells(iCounter, 5).Value
pwdchange = Cells(iCounter, 4).Value
'формируем тело письма
strBody = "Добрый день! " & vbCrLf
strBody = strBody & "Высылаю Вам сформированный 1С табель учета рабочего времени заполненный " & Status & vbCrLf
strBody = strBody & "Проверьте этот табель на достоверность, если все верно подпишите последний лист и пришлите скан-копию вместе с электронной версией табеля на мой электронный адрес и в адрес куратора в отделе подбора и кадрового администрирования для согласования (куратора уточняйте у Сафоновой Н.У.) " & vbCrLf
strBody = strBody & "Если необходимо внести изменения - вносите изменения прямо в этом же файле. " & vbCrLf
strBody = strBody & "Важно: " & vbCrLf
strBody = strBody & "1.  Новые строки добавлять нельзя " & vbCrLf
strBody = strBody & "2.  Объединять ячейки нельзя " & vbCrLf
strBody = strBody & "3.  Удалять табельные номера сотрудников нельзя " & vbCrLf
strBody = strBody & "4.  Менять название файла нельзя " & vbCrLf
strBody = strBody & "Можно менять все что касается графика и табеля работы сотрудников, а также обозначения на полях (неявки на работу, командировки, изменение графика и др.)" & vbCrLf
strBody = strBody & "Сканы проверенных и подписанных табелей необходимо предоставить " & FullUsername & ", оригиналы необходимо передать " & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.CC = Copy
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 2
' 1 - текстовый формат письма, 2 -  HTML формат

myFile = Cells(iCounter, 6).Value
FileAdd = Dir(myPath & "*.*")
Do While FileAdd <> ""
    If FileAdd Like ("*" & myFile & ".*") Then
        olMailItm.Attachments.Add myPath & FileAdd
    End If
    FileAdd = Dir
Loop

olMailItm.Body = strBody
olMailItm.Display 'Send
'следующую строку можно использовать для отладки текста письма, закомментировав предыдущую
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'отображение ошибок, если есть
If Err.Description <> "" Then MsgBox Err.Description
End Sub
[/vba]

замените строку [vba]
Код
myPath = "D:\TEMP\"
[/vba] на свой путь, или вообще заменить её на диалоговое окно выбора нужной папки (но это уже другая история)

строка [vba]
Код
olMailItm.Display 'Send
[/vba] переключена на отображение окна сообщения, что бы проверить всё ли правильно сформировалось. если ошибок нет то удалите Display '

Автор - Sancho
Дата добавления - 15.11.2018 в 13:35
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Рассылка писем через Outlook (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!