- Open Notes - http://opennotes.ru -

Открыть Outlook msg-сообщения из папки с помощью VBA и сохранить вложение

Posted By Konstantin On In VBA | No Comments

Возникла следующая задача:

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

Это можно сделать, используя Windows Scripting Host и метод Application.CreateItemFromTemplate для открытия сообщений. После открытия, можно сохранить вложения или делать все, что нужно сделать с сообщением.

Для использования макроса скопируйте макрос в Module, затем задействуйте Microsoft Scripting Runtime в меню Tools -> References… VBA-редактора:

tools-references

Путь к папке с MSG-файлами пропишите в макросе GetMSG. А путь для сохранения вложений в параметр strFolderpath макроса ListFilesInFolder.

Sub GetMSG()
' параметр True указывает на необходимость просматривать подпапки по указанному пути
' параметр False означает, что необходимо искать сообщения только по указанному пути
   ListFilesInFolder "C:\Test\", True
End Sub
 
 
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim strFile, strFileType, strAttach As String
    Dim openMsg As MailItem
 
Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFolderpath As String
 
'куда сохранять вложения
strFolderpath = "C:\Test\attachments\"
     
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
     
    For Each FileItem In SourceFolder.Files
     
    strFile = FileItem.name
       
' Здесь проверяется формат файлов
strFileType = LCase$(Right$(strFile, 4))
  If strFileType = ".msg" Then
    Debug.Print FileItem.Path
     
Set openMsg = Application.CreateItemFromTemplate(FileItem.Path)
openMsg.Display
    'необходимые действия
     
Set objAttachments = openMsg.Attachments
    lngCount = objAttachments.count
          
    If lngCount > 0 Then
      
    For i = lngCount To 1 Step -1
      
    ' Получаем имя файла
    strAttach = objAttachments.Item(i).FileName
      
    ' добавляем путь сохранения вложения
    strAttach = strFolderpath & strAttach
      
    ' Сохраняем вложение
    objAttachments.Item(i).SaveAsFile strAttach
      
    Next i
    End If
  openMsg.Close olDiscard
   
Set objAttachments = Nothing
Set openMsg = Nothing
 
' завершение необходимых действий
      End If
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If
     
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
      
End Sub

Как использовать макрос

На время тестирования мароса лучше установить на минимум настройки безопасности. Для Outlook 2010, 2013 и 2016:

  1. Откройте вкладку «Файл» (File), выберите настройки (Outlook Options) -> настройки безопасности (Trust Center).
  2. Нажмите на настройки центра безопасности (Trust Center Settings), затем на настройки макросов слева (Macro Settings)
  3. Выберите вариант уведомления обо всех макроса (Notifications for all macros) и нажмите OK. Это позволит выполнять макросы, но предварительно будет появляться сообщение об их запуске.

В Outlook 2007 и старше эта опция находится в Tools -> Macro Security.

Откройте редактор VBA нажав комбинацию Alt+F11. Чтобы добавить код в модуль:

  1. Правой кнопкой мыши нажмите на Проекте и выберите Insert > Module.
  2. Скопируйте и вставьте макрос в модуль.

Источник

Order_macros