VBA – Сохранить объект электронной почты (OLEFormat) из буфера обмена в файл

Вопрос или проблема

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

Мой код VBA для Excel выполняет следующие шаги:

  • Открывает новое окно Word и создает новый документ
  • Отслеживает событие WordApp_WindowSelectionChange, которое срабатывает, когда на документ перетаскивается электронное письмо.
  • Проверяет, сработало ли событие WordApp_WindowSelectionChange из-за того, что было встроено электронное письмо.
  • Если это было электронное письмо, то копирует встроенное письмо (которое находится в OLEFormat) в буфер обмена. Если это не было письмом, ничего не делает.
  • Закрывает документ и приложение Word после того, как письмо скопировано в буфер обмена.
  • Открывает окно проводника с помощью Shell и делает паузу, чтобы окно открылось.
  • Вставляет письмо в окно проводника с помощью sendkeys: Application.sendkeys "^v".

Этот код действительно работает! Но он медленный, так как окно проводника должно открыться, и хуже того, если пользователь щелкает и устанавливает фокус окна в другом месте, пока Excel ждет открытия окна проводника, сообщение Application.Sendkeys отправляется не туда, и все это терпит неудачу.

Я хотел бы просто получить электронное письмо в формате OLEFormat непосредственно из буфера обмена и сохранить его с помощью VBA. Я нашел много решений, которые делают это для изображений или других типов файлов, но не могу найти то, что работает для электронных писем. Мог бы кто-нибудь помочь?

К вашему сведению, я ранее пробовал использовать Excel для прямого сохранения электронного письма в формате OLEFormat с помощью Outlook, но мои настройки безопасности этого не позволяют. Если у кого-то есть альтернативный метод, который работает без использования буфера обмена, я буду рад это рассмотреть. Моё главное ограничение в том, что это должно быть осуществимо из Excel с использованием VBA.

Ответ или решение

Конечно! Давайте разберёмся, как можно сохранить объект электронной почты (OLEFormat) непосредственно из буфера обмена в файл с помощью VBA. Мы постараемся избежать использования методов, зависящих от SendKeys, чтобы улучшить производительность и надёжность кода.

Основная идея

Мы будем использовать объект DataObject из библиотеки MSForms для работы с буфером обмена. Таким образом, вы сможете получить объект OLEFormat и сохранить его в файл, минуя шаги с открытием проводника.

Шаги реализации

  1. Убедитесь, что библиотека Microsoft Forms 2.0 Object Library подключена. Это можно сделать в редакторе VBA:

    • Откройте редактор VBA (ALT + F11).
    • Перейдите в меню "Tools" > "References".
    • Найдите и отметьте Microsoft Forms 2.0 Object Library.
  2. Используйте следующий код для обработки события и сохранения письма:

Sub SaveEmailFromClipboard()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim DataObj As MSForms.DataObject
    Dim EmailData As Object
    Dim FilePath As String

    ' Укажите путь для сохранения файла
    FilePath = "C:\Path\To\Your\Folder\EmailMessage.msg"

    ' Создаём новый экземпляр Word и новый документ
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Add

    ' Делаем видимым окно Word
    WordApp.Visible = True

    ' Для обработки события выбора окна
    Application.OnTime Now + TimeValue("00:00:01"), "CheckIfEmailDropped"

    ' Закрываем Word
    WordDoc.Close False
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

Sub CheckIfEmailDropped()
    Dim DataObj As New MSForms.DataObject
    Dim EmailData As Object

    ' Получаем данные из буфера обмена
    On Error GoTo ErrorHandler
    DataObj.GetFromClipboard

    ' Проверяем, содержит ли буфер обмена OLEFormat
    If DataObj.GetText(1) <> "" Then
        Dim TempFile As String
        TempFile = Environ("TEMP") & "\TempEmail.msg"

        ' Сохраним OLE-объект как файл (вам нужно будет учесть нужный формат)
        Set EmailData = DataObj.GetData(1)

        ' Сохраняем OLE объект
        SaveOLEToFile EmailData, TempFile

        ' Перемещаем или переименовываем файл
        Name TempFile As "C:\Path\To\Your\Folder\SavedEmail.msg"
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Ошибка при получении данных из буфера обмена."
End Sub

Sub SaveOLEToFile(ByVal OLEObject As Object, ByVal FilePath As String)
    ' Здесь вам нужно будет реализовать логику для сохранения OLE объекта
    ' Обратите внимание, что это может потребовать дополнительной обработки в зависимости от того, как хранится OLE объект.
End Sub

Объяснение

  1. Создание экземпляра Word: Код открывает новый экземпляр Word и дожидается действия пользователя с перетаскиванием электронной почты.

  2. Обработка события: С помощью OnTime запускается проверка через одну секунду после завершения перетаскивания. Это даёт достаточно времени для вставки объекта в буфер обмена.

  3. Получение данных: Мы используем DataObject для извлечения содержимого из буфера обмена.

  4. Сохранение OLE-объекта: Здесь вам нужно будет реализовать функцию SaveOLEToFile, чтобы обеспечить правильное сохранение OLE-объекта. Это может варьироваться в зависимости от специфики работающего у вас объекта.

Заключение

Этот процесс позволяет избежать проблем, связанных с SendKeys, и делает ваш код более надежным и отзывчивым. Метод может потребовать дальнейшей доработки, особенно в части сохранения OLE-объекта, но он предоставляет основную структуру вашего решения.

Оцените материал
Добавить комментарий

Капча загружается...