Экспорт почтовых сообщений Outlook toMS [дубликат]

Здесь у вас есть свой собственный код, который сканирует функциональный почтовый ящик и вставляет данные электронной почты в базу данных MS Access.

• Поместите это в автономный модуль в Outlook
• Добавить ссылку « Microsoft Office x.0 База данных базы данных базы данных объектов »
• Адаптировать 3 константы поверх нее
• Создать таблицу в вашей MS Access DB с полями Subject (строка) и TS (дата)
• Опционально адаптируйте код в под My_Stuff()
• Запустите код в суб SCAN_MAILBOX()

После некоторой неизбежной настройки после вашей среды, она заполнит вашу таблицу всем предметом / временем приема всех писем в вашем почтовом ящике

Option Explicit


Const DB_PATH = "C:\thepath\YourDatabase.accdb"
Const DB_TABLE = "Your_Table"

Const MAILBOX_TO_SCAN = "Your mailbox Name"

Public Sub SCAN_MAILBOX()

    ' To perform My_Stuff on the Inbox, do :
    My_Stuff "Inbox"

    ' To perform My_Stuff on any folder/subfolder of the mailbox, do :
    ' My_Stuff "Inbox/folder/subfolder"

End Sub



Private Sub My_Stuff(strMailboxSubfolder As String)

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim Mailbox As Outlook.MAPIFolder
    Dim folderInbox As Outlook.MAPIFolder
    Dim folderToProcess As Outlook.MAPIFolder
    Dim folderItems As Outlook.Items
    Dim oEmail As Outlook.MailItem

    Dim WS As DAO.Workspace
    Dim DB As DAO.Database

    Dim e As Long
    Dim tot As Long


    On Error GoTo Err_Handler


    Set WS = DBEngine.Workspaces(0)
    Set DB = WS.OpenDatabase(DB_PATH)

    Set objNamespace = Application.GetNamespace("MAPI")
    Set Mailbox = objNamespace.Folders(MAILBOX_TO_SCAN)

    Set folderToProcess = GetFolder(strMailboxSubfolder, Mailbox)
    Set folderItems = folderToProcess.Items

    tot = folderToProcess.Items.Count

    folderToProcess.Items.Sort "ReceivedTime", True


    For e = tot To 1 Step -1

        Set oEmail = folderItems(e)

        ' Some of the oEmail usefull properties :
        Debug.Print oEmail.Subject
        Debug.Print oEmail.ReceivedTime

        ' INSERT email Subject and Received timestamp in an Access database
        DB.Execute "INSERT INTO " & DB_TABLE & " ([SUbject],[TS]) VALUES ('" & Trim(oEmail.Subject) & "',#" & Format(oEmail.ReceivedTime, "MM/DD/YYYY hh:nn:ss") & "#)"

        Set oEmail = Nothing

        DoEvents
    Next



Exit_Sub:

    Set folderItems = Nothing
    Set folderToProcess = Nothing
    Set Mailbox = Nothing
    Set objNamespace = Nothing
    Set DB = Nothing
    Set WS = Nothing

    Exit Sub

Err_Handler:
    MsgBox Err.Description, vbExclamation
    Resume Exit_Sub
    Resume

End Sub




Private Function GetFolder(strFolderPath As String, ByRef Mailbox As Outlook.MAPIFolder) As MAPIFolder

  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next

  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")

  Set objFolder = Mailbox.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If

  Set GetFolder = objFolder
  Set colFolders = Nothing

End Function

t в этой главе, как добавить кнопку для запуска кода, это слишком много. Я показал вам достаточно, чтобы экспериментировать и быстро добиваться того, чего вы хотите.