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

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

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

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 22.08.2018, 01:01   #1
РКаратаев
Новичок
Джуниор
 
Регистрация: 21.08.2018
Сообщений: 1
Восклицание сопоставление и авторассылка данных из одной книги на почту из другой книги

есть два файла:
в первом содержится уникальный код человека и иные данные, которые периодически меняются, причем в разных столбцах
во втором этот же уникальный код и почтовый ящик человека

задача:
чтобы существовал третий файл с кнопкой, при нажатии на которую будет сопоставляться уникальный код из двух исходных файлов и данные из разных столбцов отправятся в виде текста на почтовый ящик совпавшего, причём обязательно условие - отсутствие почтового клиента на компе, только офис, указав в теме письма актуальность данных на дату, ячейка с которой так же есть в одной из книг

на просторах я нашёл код для отправки письма на почту, который работает, однако он предназначен для отправки на один фиксированный ящик

Код:
Option Explicit
 
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.yandex.ru"    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
    sUsername = "YourMail@mail.ru"    ' Учетная запись на сервере
    sPass = "1234"    ' Пароль к почтовому аккаунту
 
    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 = "AddressTo@mail.ru"    'Кому
    sFrom = "YourMail@yandex.ru"    'От кого
    sSubject = "Автоотправка"    'Тема письма
    sBody = "Привет от Excel-VBA"    'Текст письма
    sAttachment = "C:/Temp/Книга1.xls"    'Вложение(полный путь к файлу)
    'Проверка наличия файла по указанному пути
    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
        'если необходимо указать SSL
        '.Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465
        '.Item(CDO_Cnf & "smtpusessl") = True
        '=====================================
        .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
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .Send
    End With
 
    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description
    End Select
    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub
_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор
_________________________



В идеале, конечно, отправитель мог бы прописывать не в коде, а в определенной ячейке свой почтовый ящик, выбирать из выпадающего списка почтовый сервер, от которого уже плясали бы дальнейшие данные в виде сервера исходящей почты, входящей почты, порт, но это уже наглость)
Всевозможные источники утверждают, что всё это можно сделать и стандартными средствами, без VBA, но у меня не получилось и я устал ломать голову, очень надеюсь на вашу поддержку!
Образцы файлов во вложении
Вложения
Тип файла: xlsx исходные данные пример.xlsx (8.2 Кб, 6 просмотров)
Тип файла: xlsx почтовые ящики пример.xlsx (8.7 Кб, 8 просмотров)
Тип файла: 7z АНАЛИЗАТОР.7z (18.1 Кб, 8 просмотров)

Последний раз редактировалось Serge_Bliznykov; 22.08.2018 в 09:33.
РКаратаев вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вызов макроса с одной книги Access в другой sasha_prof Microsoft Office Access 5 22.05.2018 16:16
Вставить данные из ячейки одной книги в textbox формы другой книги ac1-caesar Microsoft Office Excel 21 07.04.2016 14:07
Запись данных в закрытую/скрытую из UserForm другой открытой книги книги. Dark Victor Microsoft Office Excel 1 12.03.2012 18:37
Скопировать данные из некоторых ячеек одной книги в другие книги fcunited Microsoft Office Excel 8 09.06.2010 12:14