将 Outlook 链接到 Access答案

【问题标题】：Link Outlook to Access将 Outlook 链接到 Access
【发布时间】：2020-06-24 20:58:04
【问题描述】：

我需要一些建议。

我想在 Outlook 中添加一个按钮，用于将单个电子邮件中的信息复制/导入到 MS Access DB。我们目前有一个非常完善的 Access 应用程序，它是用 VBA 开发的。

但是，我不知道在尝试创建按钮时采用的最佳方法（VSTO、COM、Addon - 不熟悉这些技术中的任何一种）。

有人可以就最好的方法提供任何建议吗？

【问题讨论】：

标签： vba ms-access outlook

【解决方案1】：

这里有一些我自己的代码扫描功能邮箱并将电子邮件数据插入 MS Access 数据库。

将其放入 Outlook 的独立模块中
添加引用“Microsoft Office x.0 Access 数据库引擎对象库”
调整上面的 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

我不会在本章中介绍如何添加一个按钮来运行代码，这有点太多了。我已经向你展示了足够多的东西来进行实验并快速实现你想要的。

【讨论】：

【解决方案2】：

我会使用一个插件（vba）来测试它，然后根据你的需要移动到更实质性的东西，玩玩，你可以使用这样的东西

Sub EMAIL_TEST()

Dim olMail As MailItem

Set olMail = ActiveInspector.CurrentItem

' Pass properties from mail to access here

End Sub

【讨论】：