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

[Romka12345]

у меня есть фракталы,давай может обмен?)

[doober]

Мне нужен только Франклин
Для себя я и сам смогу написать

[Romka12345]

как правильно задать полный путь к файлу в системе windows?
ВОТ есть прога робочая , но не могу файл прикрепить!
нужна помощь

  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 = "12345darkevil" ' Пароль до поштового аккаунту
 
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 = [B6] 'Вкладення(повна дорога до файлу)
sAttachment = Cells(6, "D:\Игры\Slot").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

[VictorM]

не могу файл прикрепить!

Упаковать файл любым архиватором.
Внизу окна ввода сообщения - расширенный режим - Управление вложениями.

[VictorM]

как правильно задать полный путь к файлу

sAttachment = "C:\Temp\Книга1.xls" 'Вкладення(повна дорога до файлу)

Укажите свои параметры расположения файла

[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 = "12345darkevil" ' Пароль до поштового аккаунту

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

[VictorM]

навскидку...
если письма отправляются из Excel, на каком-либо листе создать список с адресами.
sTo = "Адрес из списка" 'Кому
и прокрутить все это дело в цикле

[Romka12345]

нет! ето файл с компа отправляется, надо что-бы 1 файл на много емейлов отправило

[VictorM]

надо что-бы 1 файл на много емейлов отправило

а я о чем говорю?
сделайте список адресов и отправляйте "1 файл на много емейлов" в цикле

[VictorM]

если письма отправляются из Excel,

нет! ето файл с компа отправляется,

...No comments...