Отправка макросом почты из Excel

[Romka12345]

есть программа отправки вложеного файла по електронной почте, но ета программа отправляеть только одному человеку електронное письмо, а нужно что-бы отправляло 10-15 человекам, как ето зделать подскажите!!!!!

 Sub Send_Mail()
Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
Dim oCDOCnf As Object, oCDOMsg As Object
Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
On Error Resume Next
'sFrom - як правило співпадає з sUsername
SMTPserver = "smtp.bigmir.net" ' SMTPServer: для Mail.ru ; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
sUsername = "darkevill@bigmir.net" ' Обліковий запис на сервері
sPass = "*******" ' Пароль до поштового аккаунту

If Len(SMTPserver) = 0 Then MsgBox "Не вказаний SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub
If Len(sUsername) = 0 Then MsgBox "Не вказаний обліковий запис", vbInformation, "www.Excel-VBA.ru": Exit Sub
If Len(sPass) = 0 Then MsgBox "Не вказаний пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub

sTo = "tumchyshinmongol@bigmir.net" 'Кому
sFrom = "romky" 'від кого
sSubject = "о" 'Тема листа
sBody = "о" 'Текст листа
sAttachment = "D:\Игры\Slot\Slot.xls" 'Вкладення(повна дорога до файлу)
sAttachment = Cells(6, "D:\Игры\Slot\Slot.xls").Value
'Перевірка наявності файлу по вказаній адресі
If Dir(sAttachment, vbDirectory) = "" Then sAttachment = ""
'Призначаємо конфігурацію CDO
Set oCDOCnf = CreateObject("CDO.Configuration")
With oCDOCnf.Fields
.Item(CDO_Cnf & "sendusing") = 2
.Item(CDO_Cnf & "smtpauthenticate") = 1
.Item(CDO_Cnf & "smtpserver") = SMTPserver
.Item(CDO_Cnf & "sendusername") = sUsername
.Item(CDO_Cnf & "sendpassword") = sPass
.Update
End With
'Створюємо повідомлення
Set oCDOMsg = CreateObject("CDO.Message")
With oCDOMsg
Set .Configuration = oCDOCnf
.BodyPart.Charset = "koi8-r"
.From = sFrom
.To = sTo
.Subject = sSubject
.TextBody = sBody
'.AddAttachment = sAttachment
If Len(sAttachment) > 0 Then .AddAttachment sAttachment

.Send
End With

Select Case Err.Number
Case -2147220973: sMsg = "Нема доступу до Інтернету"
Case -2147220975: sMsg = "Відказ Сервера SMTP"
Case 0: sMsg = "Перевірка доступу до інтернету"
End Select
MsgBox sMsg, vbInformation, "Повідомлення Надіслане!"
Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

[IgorGO]

пробуйте эту строку:

sTo = "tumchyshinmongol@bigmir.net" 'Кому

довести до ума

[VictorM]

Интересно, чем отличается этот Ваш пост от предыдущего?
Проблема с отправкой в EXCEL!
Зачем Вы их дублируете?
Это нарушение правил форума...

[VictorM]

Сообщение от IgorGO

пробуйте эту строку:

sTo = "tumchyshinmongol@bigmir.net" 'Кому

довести до ума

Предлагалось, да видимо что-то не так))

[Romka12345]

так и предыдущий мой, просто там не помогли

[Romka12345]

спосибо за помощь!

[Romka12345]

Вот Есть программа отправки файла по електронной почте , но там только почему-то на 1 емейл отправляет, а мне нужно что-би на 15 емейлов отправляло1!!!....как ето следать???

[VictorM]

Уважаемый Romka12345.
Это уже третья повторяющаяся Ваша тема.
Увидев название прикрепленного файла, я уж подумал, что есть файлик Excel, можно посмотреть, покумекать..
Однако Вы упорно выкладываете нам один и тот же код, только в разных форматах.
Сначала просто на форуме в виде кода, теперь вот еще и в доковском документе)
А ведь ответ на Ваш вопрос уже был дан.
И в первой вашей теме и во второй.
Повторю еще здесь. У Вас в коде есть строка

 sTo = "tumchyshinmongol@bigmir.net" 'Кому

В первой теме я вам писал

sTo = "Адрес из списка" 'Кому
и прокрутить все это дело в цикле

Во второй теме IgorGO также обратил Ваше внимание на эту строку

пробуйте эту строку:
Код:
sTo = "tumchyshinmongol@bigmir.net" 'Кому
довести до ума

....
а теперь что Вы хотите еще услышать/увидеть?

p.s.
Если тема будет закрыта, как дублирующая, думаю это будет правильно.

[Romka12345]

а не подскажеш как в цыкле прокрутит ето?)

[Romka12345]

просто впервые в жизни задали VBA