|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
24.10.2011, 15:01 | #1 |
Пользователь
Регистрация: 12.12.2010
Сообщений: 54
|
Функция для отправки почты без использования внешних почтовых программ
Подскажите функцию для отправки почты без использования внешних почтовых программ в обход сервера http://schemas.microsoft.com/cdo/configuration/ (т.к. он в данный момент не работает)
|
24.10.2011, 15:05 | #2 |
Форумчанин
Регистрация: 09.06.2011
Сообщений: 515
|
Может проблемы не с сервером а у Вас? У меня 10 сек. назад работало....
|
24.10.2011, 15:13 | #3 | |
Пользователь
Регистрация: 12.12.2010
Сообщений: 54
|
Цитата:
Sub Pochta() Application.DisplayAlerts = False SaveSetting Application.Name, "mail", "smtpserver", "smtp.mail.ru" ' Ваш SMTPServer SaveSetting Application.Name, "mail", "sendusername", st_sprat@mail.ru ' Ваша учетная запись SaveSetting Application.Name, "mail", "sendpassword", "*******" ' Ваш пароль Application.DisplayAlerts = wdAlertsNone Application.DisplayAlerts = wdAlertsAll Folder = GetFolderPath ReadFileNames (Folder) Send_Mail "st_sprat@mail.ru", "st_sprat@mail.ru", "Программа открыта", txt, Workbooks("Test.xls").Sheets("Work" ).Cells(1, 1).Value txt = "Проверка" 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/" On Error Resume Next: Err.Clear smtpserver = GetSetting(Application.Name, "mail", "smtpserver", "") sendusername = GetSetting(Application.Name, "mail", "sendusername", "") sendpassword = GetSetting(Application.Name, "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 .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 Send_Mail = Err = 0 End Function естественно вместо звёздочек ставлю свой пароль и почту отправлю от себя себеже |
|
24.10.2011, 15:43 | #4 |
Форумчанин
Регистрация: 09.06.2011
Сообщений: 515
|
Как по мне то что с этим кодом перемудрили, вот вариант попроще:
Sub imeil_items_send() Dim dateFTP As String, mail As String, text_mail As String, ZipName As String Dim objMsg As Object, Config As Object dateFTP = Sheets("report").Range("B3").Value " дата mail = "тема" & dateFTP " тема с датой text_mail = "текст письма" Application.DisplayAlerts = False ZipName = "K:\CorpBank\MIS_report\General\FTP \FTP rate calculator.xls" "адрес файла Set objMsg = CreateObject("CDO.Message") Set Config = CreateObject("CDO.Configuration") Set Config = objMsg.Configuration objMsg.From = "от кого" objMsg.To = "кому" objMsg.Subject = mail objMsg.TextBody = text_mail objMsg.AddAttachment ZipName Config("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 Config("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "имя сервера" Config("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 Config("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 Config("http://schemas.microsoft.com/cdo/configuration/sendusername") = "имя" Config("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "пароль" Config.Fields.Update objMsg.Send End Sub У меня работает без проблем уже больше года (только глюки когда забываю пароль сменить.) |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
PHP Скрипт для отправки почты | Vitalik010979 | PHP | 0 | 07.09.2011 23:33 |
создание сервера для чата,без использования сторонних ресурсов | spydark91 | Работа с сетью в Delphi | 7 | 10.06.2011 00:56 |
Моя программа анонимной отправки почты | kakawkin | Софт | 7 | 26.07.2010 17:34 |
Форма для отправки почты | Михаил Юрьевич | PHP | 6 | 12.08.2009 16:56 |
Как написать программу для отправки почты | GragDen | Работа с сетью в Delphi | 5 | 14.09.2007 14:12 |