Рассылка писем через Outlook

Дата: Четверг, 15.11.2018, 08:13 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 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]

Код

[/vba]Sergey21

К сообщению приложен файл: -_-.xlsm (18.3 Kb)

Сообщение отредактировал Sergey21 - Четверг, 15.11.2018, 08:29

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

Код

[/vba]

Автор - Sergey21
Дата добавления - 15.11.2018 в 08:13

китин

Дата: Четверг, 15.11.2018, 08:15 | Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

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

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Дата: Четверг, 15.11.2018, 08:31 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 0% ±

Excel 2016

Вот, вроде все отредактировал, но все равно как-то все не красиво получается

Дата: Четверг, 15.11.2018, 08:54 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 15.11.2018, 09:09 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 15.11.2018, 09:36 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 0% ±

Excel 2016

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

Дата: Четверг, 15.11.2018, 09:46 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 15.11.2018, 09:58 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 0% ±

Excel 2016

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

Дата: Четверг, 15.11.2018, 11:42 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 15.11.2018, 12:48 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 0% ±

Excel 2016

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

Sancho

Дата: Четверг, 15.11.2018, 13:35 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 279

Репутация: 19 ±

Замечаний: 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 '

Код

[/vba]

замените строку [vba]

Код

myPath = "D:\TEMP\"

Код

olMailItm.Display 'Send

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

К сообщению приложен файл: AddFile.xlsm (19.7 Kb)

Сообщение отредактировал Sancho - Четверг, 15.11.2018, 15:19

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

Как то так
[vba]

Код

[/vba]

замените строку [vba]

Код

myPath = "D:\TEMP\"

Код

olMailItm.Display 'Send

Автор - Sancho
Дата добавления - 15.11.2018 в 13:35

Дата: Среда, 19.12.2018, 12:07 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 14

Репутация: 1 ±

Замечаний: 0% ±

Excel 2016

Добрый день, макрос работает отлично:
1. Кидаю файл с макросом в папку с файлами, которые необходимо отправить
2. Запускаю макрос, создаются письма на указанные адреса электронной почты, которые записаны в колонке "A", "B", к каждому письму подцепляется свой файл, название которого указано в колонке "C"
Помогите мне еще его доработать, нужно
1. Чтобы при создании письма, текст письма, который берется с листа 2, не терял форматирование и выглядел также как я его отформатирую (цвет, курсив и т.д.) в этой ячейке.
2. В случае если на одни и те-же адреса электронной почты необходимо направить разные файлы, то создавалось одно письмо, куда вкладывались соответствующие файлы, сейчас письма создаются для каждого адреса электронной почты и одному получателю может быть направлено несколько писем с разными файлами.
Файл с макросом прилагаю

К сообщению приложен файл: ___--.xlsm (23.0 Kb)

Sancho

Дата: Среда, 26.12.2018, 15:16 | Сообщение № 13

Группа: Проверенные

Ранг: Обитатель

Сообщений: 279

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

Sergey21, Добрый день!
С первым вопросом не возьмусь - слишком много возни: разбить текст с разным форматированием на ячейки в коде для каждой вставляемой ячейки описывать формат текста, причем как я понял читая в инете формат текста для outlook пишется в html, в чем я 0

Со вторым... нужно понять за какое количество подразделений ответственен адресат столько будет и столбцов с названиями подразделений. заменить в коде кусок [vba]

Код

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

[/vba]

на такой: [vba]

Код

For i = 3 To 4
    myFile = Cells(iCounter, i).Value
    FileAdd = Dir(myPath & "*.*")

    If myFile <> "" Then
        Do While FileAdd <> ""
            If FileAdd Like ("*" & myFile & ".*") Then
                olMailItm.Attachments.Add myPath & FileAdd
            End If
            FileAdd = Dir
        Loop
    End If
Next i

[/vba]
в первой строке этой замены [vba]

Код

for i=3 to 4

[/vba] 4 меняем на последний порядковый номер вашего столбца. При этом надо понимать, что если на одно подразделение формируется несколько файлов, а это было предусмотрено в исходном коде, то вставляя несколько подразделений в одно письмо получим бардак.

Цитата Sergey21, 19.12.2018 в 12:07, в сообщении № 12 ()

1. Кидаю файл с макросом в папку с файлами, которые необходимо отправить

Зачем? лишнее

Код

[/vba]

на такой: [vba]

Код

[/vba]
в первой строке этой замены [vba]

Код

for i=3 to 4

Цитата Sergey21, 19.12.2018 в 12:07, в сообщении № 12 ()

1. Кидаю файл с макросом в папку с файлами, которые необходимо отправить

Зачем? лишнееSancho

К сообщению приложен файл: 1111111.xlsm (21.5 Kb)