Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
20.04.2024, 12:22:39

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
33 242 Сообщений в 5 457 Тем от 6 758 Пользователей
Последний пользователь: Сергей2662
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Outlook и VBA
| | |-+  Сохранение данных письма, на которое происходит ответ. Макросом в Excel VBA
Страниц: [1]   Вниз
Печать
Автор Тема: Сохранение данных письма, на которое происходит ответ. Макросом в Excel VBA  (Прочитано 8760 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Lena_VVV
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 3


Просмотр профиля
« : 12.01.2020, 20:41:32 »

Друзья всем привет, помогите пожалуйста с такой проблемой: есть макрос в excel, который ищет письмо по указанной теме во всех входящих папках Outlook, затем отвечает на найденное письмо с определенным текстом, в который будет состоять в том числе из переменной равной теме письма. Когда я вставляю тело письма "".Body = "blah blah hello world" весь текст предыдущего стирается, остается только   "blah blah hello world. Как оставить весь текст предыдущего письма и поля  From..., СС.. и т. д предыдущего письма, которые автоматически формируется если отвечаешь на какое-либо письмо?
Всем спасибо за помощь)
Код: (vb)
Public Sub Example(ByVal Tema As String)
    
    Dim OutApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.MAPIFolder
 
    Set OutApp = New Outlook.Application 'активируем почту
    Set Namespace = OutApp.GetNamespace("MAPI") 'доступ ко всем данным Outlook, хранящимся в почтовых хранилищах пользователя.
'    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox) 'возвращается папка в коллекции папок
 
'   запускаем функцию - ищет письма с определенной темой во всех входящих с подпапками
    LoopFolders Inbox, Tema
 
    Set Inbox = Nothing
    
    MsgBox "Поиск писем закончен"
    
End Sub
 
Private Function LoopFolders(ByVal ParentFldr As Outlook.MAPIFolder, ByVal Tema As String)
 
    'тема письма, которую ищем
    Dim Subject As String
        Subject = Tema
 
'    Фильтр поиска по теме
    Dim Filter As String
    Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
                       Chr(34) & " >= '01/01/1900' And " & _
                       Chr(34) & "urn:schemas:httpmail:datereceived" & _
                       Chr(34) & " < '12/31/2100' And " & _
                       Chr(34) & "urn:schemas:httpmail:subject" & _
                       Chr(34) & "Like '%" & Subject & "%'"
 
    Dim Items As Outlook.Items
    Set Items = ParentFldr.Items.Restrict(Filter) 'возвращая новую коллекцию, содержащую все элементы из исходного объекта, которые совпадают с фильтром
        Items.Sort "[ReceivedTime]", False 'Сортирует коллекцию элементов по указанному свойству, по возрастанию
      
'    Если письмо с указанной темой было найдено
    If Items.Count <> 0 Then
        Found = True
        ' Для найденного письма формируем ответное письмо
        For Each itm In Items
          Set ReplyAll = itm.ReplyAll 'ответить всем в письме
            With ReplyAll
                .SentOnBehalfOfName = "#*@*.ru" ' Поле "От" если необходимо отправить письмо от рассылки
                .To = "#*@*.ru" 'Поле "Кому"
                .CC = "#*@*.ru" 'Поле "Копия"
                .Body = "blah blah hello world"  'вставить заготовку тескта-ответа
                .Display 'показать письмо
            End With
        Next
    End If
    
'    myOlApp.Quit
'    Set myOlApp = Nothing
    
 
    Dim SubFldr As Outlook.MAPIFolder
'   //Рекурсировать через SubFldrs
    If ParentFldr.Folders.Count > 0 Then
        For Each SubFldr In ParentFldr.Folders
            LoopFolders SubFldr, Tema
            Debug.Print SubFldr.Name
        Next
    End If
    
End Function
« Последнее редактирование: 12.01.2020, 21:26:32 от Lena_VVV » Записан
vikttur
Глобальный модератор
Ветеран
*****

Репутация: +124/-0
Офлайн Офлайн

Сообщений: 1 816



Просмотр профиля
« Ответ #1 : 13.01.2020, 02:01:44 »

Обсуждение
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru