Отправка приложенного файла через smtp - VB
Формулировка задачи:
Добрый день!
Использую данный код:
Но не знаю, какой командой вставить отпрвку файла (допустим лежит в папке с программой)... и нигде не могу найти мануал
.AddAttachment = "C:\order.xls"
Не работает...
Заранее благодарен за подсказку!
Листинг программы
- 'ГЋГІГЇГ°Г*ГўГЄГ* ГЇГЁГ±ГјГ¬Г*
- Set o_Mess = CreateObject("CDO.Message")
- v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
- With o_Mess
- .BodyPart.Charset = "utf-8"
- .To = EMAIL_cfg
- .From = EMAIL_cfg
- .Subject = EMAIL_subject_cfg & " - " & String_msg
- .TextBody = String_msg & String_user & String_00 & String_01 & String_02 & String_03 & String_04 & String_05 & String_06 & String_07 & String_08 & String_09 & String_10 & String_11 & String_contacts
- With .Configuration.Fields
- .Item(v_Conf & "sendusing") = 2
- .Item(v_Conf & "smtpserver") = EMAIL_smtp_cfg
- .Item(v_Conf & "smtpauthenticate") = 1
- .Item(v_Conf & "sendusername") = EMAIL_user_cfg
- .Item(v_Conf & "sendpassword") = EMAIL_pass_cfg
- .Item(v_Conf & "smtpserverport") = 25
- .Item(v_Conf & "smtpusessl") = False
- .Item(v_Conf & "smtpconnectiontimeout") = 60
- .Update
- End With
- .Send
- End With
Решение задачи: «Отправка приложенного файла через smtp»
textual
Листинг программы
- Option Explicit
- Private Sub TEST()
- Dim txt$
- SaveAccountData
- txt = "Это письмо сформировано макросом" & vbNewLine & "без использования внешних программ и подключения дополнительных библиотек"
- If Send_Mail("FelixMacintosh@yandex.ru", "FelixMacintosh@yandex.ru", "проверка отправки почты_2", _
- txt) Then
- MsgBox "Письмо успешно отправлено", vbInformation
- Else
- MsgBox "Не удалось отправить письмо", vbExclamation
- End If
- End Sub
- Sub SaveAccountData() 'запускать один раз - для записи в реестр Windows параметров почтового аккаунта
- SaveSetting App.EXEName, "mail", "smtpserver", "smtp.yandex.ru" 'Ваш SMTPServer
- SaveSetting App.EXEName, "mail", "sendusername", "FelixMacintosh@yandex.ru" 'Ваша учетная запись
- SaveSetting App.EXEName, "mail", "sendpassword", "XXXXXXX" 'Ваш пароль
- End Sub
- Function Send_Mail(ByVal MailTo As String, ByVal MailFrom As String, ByVal MailSubject As String, _
- ByVal MailText As String, Optional ByVal MailAttachment As String = "") As Boolean
- 'функция для отправки почты без использования внешних почтовых программ
- '----------------------------------------------------------------------
- 'в качестве параметров получает:
- 'MailTo - адрес получателя письма
- 'MailFrom - адрес отправителя письма
- 'MailSubject - тема письма
- 'MailText - текст письма
- 'MailAttachment - полный путь к файлу вложения (необязательный параметр)
- '----------------------------------------------------------------------
- 'возвращает TRUE, если отправка почты произошла успешно, и FALSE в обратном случае
- Const cdoConfigURL = "http://schemas.microsoft.com/cdo/configuration/"
- Dim smtpserver$, sendusername$, sendpassword$
- Dim cdoConfig As Object, cdoMessage As Object
- On Error Resume Next: Err.Clear
- smtpserver = GetSetting(App.EXEName, "mail", "smtpserver", "")
- sendusername = GetSetting(App.EXEName, "mail", "sendusername", "")
- sendpassword = GetSetting(App.EXEName, "mail", "sendpassword", "")
- If Len(smtpserver) = 0 Or Len(sendusername) = 0 Or Len(sendpassword) = 0 Then Exit Function
- Set cdoConfig = CreateObject("CDO.Configuration")
- With cdoConfig.Fields
- .Item(cdoConfigURL & "sendusing") = 2
- .Item(cdoConfigURL & "smtpauthenticate") = 1
- .Item(cdoConfigURL & "smtpserver") = smtpserver
- .Item(cdoConfigURL & "sendusername") = sendusername
- .Item(cdoConfigURL & "sendpassword") = sendpassword
- 'для отправки почты с аккаунта @gmail.com
- .Item(cdoConfigURL & "smtpserverport") = 465 'порт для SSL: 465
- .Item(cdoConfigURL & "smtpusessl") = 1 'использовать аутентификацию: да
- .Update
- End With
- Set cdoMessage = CreateObject("CDO.Message")
- With cdoMessage
- Set .Configuration = cdoConfig
- .BodyPart.Charset = "koi8-r"
- .From = MailFrom:
- .To = MailTo
- .Subject = MailSubject
- .TextBody = MailText
- If Len(MailAttachment) > 0 Then .AddAttachment MailAttachment 'Вложение !
- .Send
- End With
- Set cdoMessage = Nothing: Set cdoConfig = Nothing
- 'If Err.Number = -2147220973 Then MsgBox ("Отсутствует связь с интернетом")
- 'If Err.Number = -2147220975 Then MsgBox ("SMTP сервер ответил отказом")
- 'If Err.Number = 0 Then MsgBox ("Письмо отправлено")
- Send_Mail = Err = 0
- End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д