0

我需要构建一个工具，允许用户从他的 Outlook 中选择一封电子邮件，这样我就可以将该电子邮件保存为 .msg 文件，或者仅将附件保存为文件。

我对允许搜索/过滤电子邮件的最简单和最好的方法有点磕磕绊绊。我需要给用户一个至少与 Outlook 稍微相似的视图（例如，文件夹应该是相同的顺序/层次结构。

Outlook 对象模型是否有某种我可以调用的 Explorer/Picker/Selection 对话框，在用户选择电子邮件后将返回 storeid 和 entryid？还是我需要自己动手？

我应该提到我已经知道如何保存电子邮件或附件，所以我的问题只是关于处理电子邮件的选择和过滤。

仅供参考，我正在使用 Outlook 2007 在 MS Access 2007 中对此进行编程。目标计算机具有 2007 或 2010 版本的 Access 和 Outlook。

4

2 回答 2

0

我很少使用 Access 进行编程，但我从 Outlook 中移动了一些代码，稍微修改了一下，它似乎可以工作。这不是一个解决方案，但它应该向您展示如何访问您需要的所有信息。

我有一个问题。如果 Outlook 已经打开，也Set OutApp = CreateObject("Outlook.Application")不要创建新的 Outlook 实例。Set OutApp = New Outlook.Application因此Quit关闭 Outlook，无论它在宏启动之前是否打开。我建议你就这个问题发布一个新问题；我相信有人知道如何判断 Outlook 是否已经打开，因此不要退出它。

Outlook 中的文件夹结构有点尴尬，因为顶级文件夹是 typeFolders而所有子文件夹都是 type MAPIFolder。一旦你过去了，它就相当简单了。

下面的代码包括功能GetListSortedChildren(ByRef Parent As MAPIFolder) As String。此函数查找 Parent 的所有子项并返回一个字符串，例如“5,2,7,1,3,6,4”，该字符串按名称按升序列出子项的索引。我会使用这样的东西通过根据用户需要扩展节点来填充 ListView。

我提供了一个子例程CtrlDsplChld()，它控制按顺序输出到所有文件夹的直接窗口。我相信这应该为您提供足够的指导来开始访问文件夹层次结构。

子例程DsplChld(ByRef Parent As MAPIFolder, ByVal Level As Long)包括查找带有附件的第一条消息的代码。这将告诉您如何在文件夹中查找特定消息。

最后，CtrlDsplChld()显示邮件的选定属性：主题、收件人、HTMLBody 和附件的显示名称。

希望这可以帮助。

Option Compare Database
Option Explicit
Dim ItemWithMultipleAttachments As Outlook.MailItem
Sub CtrlDsplChld()

  Dim ArrChld() As String
  Dim ListChld As String
  Dim InxAttach As Long
  Dim InxChld As Long
  Dim InxTopLLCrnt As Long
  Dim OutApp As Outlook.Application
  Dim TopLvlList As Folders

  Set ItemWithMultipleAttachments = Nothing

  Set OutApp = CreateObject("Outlook.Application")
  'Set OutApp = New Outlook.Application

  With OutApp

    Set TopLvlList = .GetNamespace("MAPI").Folders

    For InxTopLLCrnt = 1 To TopLvlList.Count
      ' Display top level children and their children
      Call DsplChld(TopLvlList.Item(InxTopLLCrnt), 0)
    Next

    If Not ItemWithMultipleAttachments Is Nothing Then
      With ItemWithMultipleAttachments
        Debug.Print .Subject
        Debug.Print .HTMLBody
        Debug.Print .To
        For InxAttach = 1 To .Attachments.Count
          Debug.Print .Attachments(InxAttach).DisplayName
        Next
      End With
    End If
    .Quit
  End With
  Set OutApp = Nothing

End Sub
Sub DsplChld(ByRef Parent As MAPIFolder, ByVal Level As Long)

  Dim ArrChld() As String
  Dim InxChld As Long
  Dim InxItemCrnt As Long
  Dim ListChld As String

  Debug.Print Space(Level * 2) & Parent.Name

  If ItemWithMultipleAttachments Is Nothing Then
    ' Look down this folder for a mail item with an attachment
    For InxItemCrnt = 1 To Parent.Items.Count
      With Parent.Items(InxItemCrnt)
        If .Class = olMail Then
          If .Attachments.Count > 1 Then
            Set ItemWithMultipleAttachments = Parent.Items(InxItemCrnt)
            Exit For
          End If
        End If
      End With
    Next
  End If

  ListChld = GetListSortedChildren(Parent)
  If ListChld <> "" Then
    ' Parent has children
    ArrChld = Split(ListChld, ",")
    For InxChld = LBound(ArrChld) To UBound(ArrChld)
      Call DsplChld(Parent.Folders(ArrChld(InxChld)), Level + 1)
    Next
  End If

End Sub
Function GetListSortedChildren(ByRef Parent As MAPIFolder) As String

  ' The function returns "" if Parent has no children.
  ' If the folder has children, the functions returns "P,Q,R, ..." where
  ' P, Q, R and so on indices of the children of Parent in ascending
  ' order by name.

  Dim ArrInxFolder() As Long
  'Dim ArrFolder() As MAPIFolder
  Dim InxChldCrnt As Long
  Dim InxName As Long
  Dim ListChld As String

 If Parent.Folders.Count = 0 Then
   ' No children
   GetListSortedChildren = ""
 Else
 'ReDim ArrName(1 To Parent.Folders.Count)
 'For InxChldCrnt = 1 To Parent.Folders.Count
 '  ArrFolder(InxChldCrnt) = Parent.Folders(InxChldCrnt)
 'Next
 Call SimpleSortMAPIFolders(Parent, ArrInxFolder)
   ListChld = CStr(ArrInxFolder(1))
   For InxChldCrnt = 2 To Parent.Folders.Count
     ListChld = ListChld & "," & CStr(ArrInxFolder(InxChldCrnt))
   Next
   GetListSortedChildren = ListChld
 End If
End Function
Sub SimpleSortMAPIFolders(ArrFolder As MAPIFolder, _
                                        ByRef InxArray() As Long)

  ' On exit InxArray contains the indices into ArrFolder sequenced by
  ' ascending name.  The sort is performed by repeated passes of the list
  ' of indices that swap adjacent entries if the higher come first.
  ' Not an efficient sort but adequate for short lists.

  Dim InxIACrnt As Long
  Dim InxIALast As Long
  Dim NoSwap As Boolean
  Dim TempInt As Long

  ReDim InxArray(1 To ArrFolder.Folders.Count)  ' One entry per sub folder
  ' Fill array with indices
  For InxIACrnt = 1 To UBound(InxArray)
    InxArray(InxIACrnt) = InxIACrnt
  Next

  If ArrFolder.Folders.Count = 1 Then
    ' One entry list already sorted
    Exit Sub
  End If

  ' Each repeat of the loop moves the folder with the highest name
  ' to the end of the list.  Each repeat checks one less entry.
  ' Each repeats partially sorts the leading entries and may result
  ' in the list being sorted before all loops have been performed.
  For InxIALast = UBound(InxArray) To 1 Step -1
    NoSwap = True
    For InxIACrnt = 1 To InxIALast - 1
      If ArrFolder.Folders(InxArray(InxIACrnt)).Name > _
         ArrFolder.Folders(InxArray(InxIACrnt + 1)).Name Then
        NoSwap = False
        ' Move higher entry one slot towards the end
        TempInt = InxArray(InxIACrnt)
        InxArray(InxIACrnt) = InxArray(InxIACrnt + 1)
        InxArray(InxIACrnt + 1) = TempInt
      End If
    Next
    If NoSwap Then
      Exit For
    End If
  Next

End Sub
于 2012-04-25T11:59:23.807 回答
0

链接到 Outlook 表很好。问题是 Outlook 没有为每封邮件提供唯一的 ID，如果邮件从一个文件夹移动到另一个文件夹，其 ID 会更改。显然不是由了解数据库的人设计的。

更好的方法可能是创建一个在 Outlook 中运行的 Outlook 加载项，然后执行将信息发送到 Access 所需的任务。

于 2012-04-23T14:50:06.810 回答