查找并从MS选择一个Outlook电子邮件访问

Question

我需要建立一个工具，允许用户从他的Outlook中选择一个电子邮件，所以我可以说电子邮件，然后保存为.msg文件或交替只是保存附件作为文件。

我绊倒了可能是最简单的一点点，并允许电子邮件的搜索/过滤的最佳途径。我需要为用户提供一个至少与Outlook略有相似的视图（例如，文件夹应该是相同的订单/层次结构。

Outlook对象模型是否具有某种Explorer/Picker/Selection对话框我可以调用用户选择电子邮件后，将返回STOREID和的EntryID？或者我需要推出自己的？

我要指出，我已经知道如何保存电子邮件或附件，所以我的问题是，只有处理选择和电子邮件过滤。

通知你，我在MS Access 2007与Outlook 2007编程这个目标机器可以访问和Outlook或者2007或2010的版本。

Answer 1

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

一个更好的办法可能是创建在Outlook中运行一个Outlook插件，然后执行需要将信息发送给访问的任务。

Answer 2

我很少使用Access进行编程，但是我从Outlook中移动了一些代码，绕了一下它并且似乎有效。这不是一个解决方案，但它应该告诉你如何访问你需要的所有信息。

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

Outlook中的文件夹结构有些尴尬，因为顶级文件夹的类型为Folders，而所有子文件夹的类型为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