Добрый день, подскажите, пытаюсь создать несколько сообщений в 1 макросе (необходимо 10 сообщений - 1 макросом), но ничего не выходит, ниже код, пытаюсь изначально сделать хотя бы 2 сообщения в связке, пожалуйста подскажите
Код |
---|
Sub Send_Mail() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = Range("B1").Value 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sCC = Range("B2").Value 'Копия(можно заменить значением из ячейки - sBCC = Range("A1").Value) sBCC = Range("B3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value) sSubject = Range("B5").Value 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = Range("B7").Value 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = sCC 'адрес для копии .BCC = sBCC 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = Range("B1").Value 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sCC = Range("B2").Value 'Копия(можно заменить значением из ячейки - sBCC = Range("A1").Value) sBCC = Range("B3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value) sSubject = Range("B5").Value 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = Range("B7").Value 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = sCC 'адрес для копии .BCC = sBCC 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |