Question

我需要一些建议。

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

但是，在尝试创建按钮（VSTO，COM，Addon - 不熟悉其中任何技术）时，我对最佳方法感到茫然。

有人可以就此采取最佳方法提出任何建议吗？

Answer 1

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

将其放入Outlook中的独立模块
添加引用＆＃34; Microsoft Office x.0 Access数据库引擎对象库＆＃34;
在其上面调整3个常量
在MS Access数据库中创建一个包含字段Subject（字符串）和TS（日期）
Optionnaly调整子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

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

Answer 2

我会使用加载项（vba）来测试它，然后根据你的需要转移到更实质的东西，玩游戏，你可以使用这样的东西

Sub EMAIL_TEST()

Dim olMail As MailItem

Set olMail = ActiveInspector.CurrentItem

' Pass properties from mail to access here

End Sub

将Outlook链接到访问

2 个答案: