Отправка приложенного файла через smtp - VB

Узнай цену своей работы

Формулировка задачи:

Добрый день! Использую данный код:
Листинг программы
  1. 'ГЋГІГЇГ°Г*ГўГЄГ* ГЇГЁГ±ГјГ¬Г*
  2. Set o_Mess = CreateObject("CDO.Message")
  3. v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
  4. With o_Mess
  5. .BodyPart.Charset = "utf-8"
  6. .To = EMAIL_cfg
  7. .From = EMAIL_cfg
  8. .Subject = EMAIL_subject_cfg & " - " & String_msg
  9. .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
  10. With .Configuration.Fields
  11. .Item(v_Conf & "sendusing") = 2
  12. .Item(v_Conf & "smtpserver") = EMAIL_smtp_cfg
  13. .Item(v_Conf & "smtpauthenticate") = 1
  14. .Item(v_Conf & "sendusername") = EMAIL_user_cfg
  15. .Item(v_Conf & "sendpassword") = EMAIL_pass_cfg
  16. .Item(v_Conf & "smtpserverport") = 25
  17. .Item(v_Conf & "smtpusessl") = False
  18. .Item(v_Conf & "smtpconnectiontimeout") = 60
  19. .Update
  20. End With
  21. .Send
  22. End With
Но не знаю, какой командой вставить отпрвку файла (допустим лежит в папке с программой)... и нигде не могу найти мануал .AddAttachment = "C:\order.xls" Не работает... Заранее благодарен за подсказку!

Решение задачи: «Отправка приложенного файла через smtp»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Sub TEST()
  4.     Dim txt$
  5.     SaveAccountData
  6.     txt = "Это письмо сформировано макросом" & vbNewLine & "без использования внешних программ и подключения дополнительных библиотек"
  7.     If Send_Mail("FelixMacintosh@yandex.ru", "FelixMacintosh@yandex.ru", "проверка отправки почты_2", _
  8.     txt) Then
  9.         MsgBox "Письмо успешно отправлено", vbInformation
  10.     Else
  11.         MsgBox "Не удалось отправить письмо", vbExclamation
  12.     End If
  13. End Sub
  14.  
  15.  
  16. Sub SaveAccountData() 'запускать один раз - для записи в реестр Windows параметров почтового аккаунта
  17.    SaveSetting App.EXEName, "mail", "smtpserver", "smtp.yandex.ru" 'Ваш SMTPServer
  18.    SaveSetting App.EXEName, "mail", "sendusername", "FelixMacintosh@yandex.ru" 'Ваша учетная запись
  19.    SaveSetting App.EXEName, "mail", "sendpassword", "XXXXXXX" 'Ваш пароль
  20. End Sub
  21.  
  22. Function Send_Mail(ByVal MailTo As String, ByVal MailFrom As String, ByVal MailSubject As String, _
  23. ByVal MailText As String, Optional ByVal MailAttachment As String = "") As Boolean
  24.     'функция для отправки почты без использования внешних почтовых программ
  25.    '----------------------------------------------------------------------
  26.    'в качестве параметров получает:
  27.    'MailTo - адрес получателя письма
  28.    'MailFrom - адрес отправителя письма
  29.    'MailSubject - тема письма
  30.    'MailText - текст письма
  31.    'MailAttachment - полный путь к файлу вложения (необязательный параметр)
  32.    '----------------------------------------------------------------------
  33.    'возвращает TRUE, если отправка почты произошла успешно, и FALSE в обратном случае
  34.    Const cdoConfigURL = "http://schemas.microsoft.com/cdo/configuration/"
  35.     Dim smtpserver$, sendusername$, sendpassword$
  36.     Dim cdoConfig As Object, cdoMessage As Object
  37.     On Error Resume Next: Err.Clear
  38.     smtpserver = GetSetting(App.EXEName, "mail", "smtpserver", "")
  39.     sendusername = GetSetting(App.EXEName, "mail", "sendusername", "")
  40.     sendpassword = GetSetting(App.EXEName, "mail", "sendpassword", "")
  41.     If Len(smtpserver) = 0 Or Len(sendusername) = 0 Or Len(sendpassword) = 0 Then Exit Function
  42.     Set cdoConfig = CreateObject("CDO.Configuration")
  43.     With cdoConfig.Fields
  44.         .Item(cdoConfigURL & "sendusing") = 2
  45.         .Item(cdoConfigURL & "smtpauthenticate") = 1
  46.         .Item(cdoConfigURL & "smtpserver") = smtpserver
  47.         .Item(cdoConfigURL & "sendusername") = sendusername
  48.         .Item(cdoConfigURL & "sendpassword") = sendpassword
  49.         'для отправки почты с аккаунта @gmail.com
  50.        .Item(cdoConfigURL & "smtpserverport") = 465 'порт для SSL: 465
  51.        .Item(cdoConfigURL & "smtpusessl") = 1 'использовать аутентификацию: да
  52.        .Update
  53.     End With
  54.     Set cdoMessage = CreateObject("CDO.Message")
  55.     With cdoMessage
  56.         Set .Configuration = cdoConfig
  57.         .BodyPart.Charset = "koi8-r"
  58.         .From = MailFrom:
  59.         .To = MailTo
  60.         .Subject = MailSubject
  61.         .TextBody = MailText
  62.         If Len(MailAttachment) > 0 Then .AddAttachment MailAttachment 'Вложение !
  63.        .Send
  64.     End With
  65.     Set cdoMessage = Nothing: Set cdoConfig = Nothing
  66.     'If Err.Number = -2147220973 Then MsgBox ("Отсутствует связь с интернетом")
  67.    'If Err.Number = -2147220975 Then MsgBox ("SMTP сервер ответил отказом")
  68.    'If Err.Number = 0 Then MsgBox ("Письмо отправлено")
  69.    Send_Mail = Err = 0
  70. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут