Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 11.03.2010, 20:43   #21
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

Цитата:
Сообщение от valerij Посмотреть сообщение
Да, написано, но почему тогда он, макрос, не указывает, типа "С запрошенным действием не связана программа электронной почты. Установите программу электронной почты или, если она уже установлена, создайте связь в панели управления "Программы по умолчанию"?
Да потому что там макрос сам обращается именно к Outlook и все равно что там по умолчанию установлено(не установлено), отправлено будет именно через Outlook!
А приведенный мной пример обращается именно к почтовой программе по умолчанию. Теперь понятна разница?
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума
Старый 11.03.2010, 21:33   #22
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от The_Prist Посмотреть сообщение
Да потому что там макрос сам обращается именно к Outlook и все равно что там по умолчанию установлено(не установлено), отправлено будет именно через Outlook!
А приведенный мной пример обращается именно к почтовой программе по умолчанию. Теперь понятна разница?
Prist!!
Супер понятно, СПАСИБО!!!!!
Так не охота эту дребедень(Outlook, Бат ...) ставить...
Может doober, сделает и в сети куча макросов и все либо с Outlook, либо не работают.
valerij вне форума
Старый 11.03.2010, 21:46   #23
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Извените за задержку,под вечер тяжело пробиться в интернет
Проверил работает.Главное правильно укажите Smtp сервер,учетную запись и пароль.Если что не получится пишите в личку,и сразу свое мыло,есть особенности в SMTP серверах.
В референсах добавить ссылку на
Microsoft CDO for Windows 2000 Library
Код:

Sub My_send()

    Dim WB As Workbook
    Dim ind As Integer
   ind = ActiveSheet.Index
     Application.DisplayAlerts = False
        Set WB = Workbooks.Add   ' создаём новую книгу
    Dim li As Long
    Application.DisplayAlerts = False
    For n = ind To 1 Step -1
      ThisWorkbook.Sheets(n).Copy Before:=WB.Sheets(1)
    Next
    WB.SaveAs Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls", xlNormal
    WB.Close False
    Application.DisplayAlerts = True
    Set cdoConfig = CreateObject("CDO.Configuration")
 
    With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
     
       .Item(cdoSMTPAuthenticate) = 1
       .Item(cdoSMTPServer) = "mail.rambler.ru" ' Ваш SMTPServer
       .Item(cdoSendUserName) = "Vasya" ' Ваша учетная запись
        .Item(cdoSendPassword) = "111111" ' Ваш  пароль
        .Update
    End With
 
    Set cdoMessage = CreateObject("CDO.Message")
 
    With cdoMessage
       On Error Resume Next
    
        Set .Configuration = cdoConfig
        .From = "Vasya@rambler.ru" ' отправитель
        
        .To = "Vasya2@rambler.ru" 'Получатель.Если не один то через запятую
        .Subject = "Здесь тема письма"
        .TextBody = "текст тела письма"
        .AddAttachment Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls" ' Добавляем файл
        .Send
    End With
  If Err.Number = -2147220973 Then
        MsgBox ("Отсутствует связь с интернетом")
    End If
    If Err.Number = -2147220975 Then
           MsgBox ("SMTP сервер ответил отказом")
    End If
    Set cdoMessage = Nothing
    Set cdoConfig = Nothing

 If Err.Number = 0 Then
       MsgBox ("Письмо отправлено")
End If
  Kill Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls"
End Sub
Анализ,обработка данных Недорого
doober вне форума
Старый 12.03.2010, 01:28   #24
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от doober Посмотреть сообщение
В референсах добавить ссылку на
Microsoft CDO for Windows 2000 Library
doober!
А нет у меня Microsoft CDO for Windows 2000 Library, а почему?

Microsoft Office 2003, может потому, что при установки выбран тока эксель и ворд?
valerij вне форума
Старый 12.03.2010, 01:35   #25
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Не може цього бути

только если у Вас Винда 95 -98
с 2000 эта библиотека присутствует
Не знаю как в Висте
Анализ,обработка данных Недорого
doober вне форума
Старый 12.03.2010, 01:37   #26
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Поищите в Папке WINDOWS SYSTEM 32 cdosys.dll
Анализ,обработка данных Недорого

Последний раз редактировалось doober; 12.03.2010 в 01:43.
doober вне форума
Старый 12.03.2010, 01:46   #27
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от doober Посмотреть сообщение
Поищите в Папке WINDOWS 32 cdosys.dll
У меня 7, нашел, просто переставил офис с Расширенная настройка приложений.
Но ошибка
Set cdoConfig = CreateObject("CDO.Configuration")
Изображения
Тип файла: jpg zx.jpg (77.8 Кб, 220 просмотров)
valerij вне форума
Старый 12.03.2010, 01:50   #28
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Значит в 7 есть другая библиотека.Пороюсь на просторах,поищу что нибудь.
Анализ,обработка данных Недорого
doober вне форума
Старый 12.03.2010, 02:10   #29
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,858
По умолчанию

Немного переработал функцию, предложенную doober
(давно искал подобную функцию - которой для отправки почты не нужны почтовые программы)

Вот что получилось: http://excelvba.ru/code/CDO

Код:
Sub SaveAccountData()    ' запускать один раз - для записи в реестр Windows параметров почтового аккаунта
    SaveSetting Application.Name, "mail", "smtpserver", "smtp.mail.ru"    ' Ваш SMTPServer
    SaveSetting Application.Name, "mail", "sendusername", "vasya_pupkin@mail.ru"    ' Ваша учетная запись
    SaveSetting Application.Name, "mail", "sendpassword", "pup123456"    ' Ваш  пароль
End Sub

Sub Main()    ' Пример использования функции Send_Mail
    txt = "Это письмо сформировано макросом" & vbNewLine & _
          "без использования внешних программ и подключения дополнительных библиотек"
    If Send_Mail("ivan_ivanov@mail.ru", "vasya_pupkin@mail.ru", "проверка отправки почты", txt) Then
        MsgBox "Письмо успешно отправлено", vbInformation
    Else
        MsgBox "Не удалось отправить письмо", vbExclamation
    End If
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

    '    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
Добавил строку .BodyPart.Charset = "koi8-r" - без неё в письме приходили кракозябры (получал почту при помощи TheBat!)

Ну и заменил все константы в коде их значениями - чтобы не требовалась ссылка на библиотеку Microsoft CDO for Windows 2000 Library

Код проверил - работает замечательно.

Последний раз редактировалось EducatedFool; 06.09.2011 в 11:12.
EducatedFool вне форума
Старый 12.03.2010, 02:33   #30
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
Вот что получилось:.
Ну что, такое....
Заменил своими, красным
Код:
Sub SaveAccountData()    ' запускать один раз - для записи в реестр Windows параметров почтового аккаунта
    SaveSetting Application.Name, "mail", "smtpserver", "smtp.yandex.ru"    ' Ваш SMTPServer
    SaveSetting Application.Name, "mail", "sendusername", "valeri0749@yandex.ru"    ' Ваша учетная запись
    SaveSetting Application.Name, "mail", "sendpassword", "111111"    ' Ваш  пароль
End Sub

Sub Main()    ' Пример использования функции Send_Mail
    txt = "Это письмо сформировано макросом" & vbNewLine & _
          "без использования внешних программ и подключения дополнительных библиотек"
    If Send_Mail("valeri0749@yandex.ru", "valeri0749@yandex.ru", "проверка отправки почты", txt) Then
        MsgBox "Письмо успешно отправлено", vbInformation
    Else
        MsgBox "Не удалось отправить письмо", vbExclamation
    End If
End Sub
Пишет:
"Не удалось отправить письмо"

Последний раз редактировалось valerij; 12.03.2010 в 03:25.
valerij вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Отправка почты Fess HTML и CSS 15 11.03.2010 20:24
Отправка почты Fo][ Работа с сетью в Delphi 1 20.01.2009 23:15
отправка почты? gusluk Работа с сетью в Delphi 2 17.11.2008 07:45
Отправка почты Fenix Nexsais Работа с сетью в Delphi 5 06.09.2007 22:27
Отправка почты Mikola PHP 4 12.08.2007 04:17