MS AccessからOutlookの電子メールを検索して選択する

Question

Outlookから電子メールを選択できるツールを構築する必要があります。その電子メールを.msgファイルとして保存するか、ファイル。

私は、電子メールの検索/フィルタリングを可能にする最も簡単で最良の方法かもしれません。私は、Outlookに少なくとも少し類似したビューをユーザーに与える必要があります（たとえば、フォルダは同じ順序/階層でなければなりません）。

Outlookオブジェクトモデルには何らかの種類のExplorer/Picker/Selectionダイアログがあります。

私は電子メールまたは添付ファイルを保存する方法を既に知っているので、私の質問は取り扱いに関するものです電子メールの選択とフィルタリング

私は、2007年版のOutlook 2007でこれをプログラミングしています。ターゲットマシンには、2007年版と2010版のAccess and Outlookがあります。

Answer 1

Outlookテーブルへのリンクは正常です。問題は、Outlookが各メッセージに一意のIDを提供せず、メッセージがあるフォルダから別のフォルダに移動さ​​れた場合、そのIDが変更されることです。明らかにデータベースを理解している人が設計したものではありません。

Outlookで実行されるOutlookアドインを作成し、その情報をAccessに送信するのに必要なタスクを実行する方がよい場合があります。

Answer 2

私はめったにAccessでプログラムしますが、Outlookからいくつかのコードを移動して、ちょっとハックしてしまい、うまくいくようです。これは解決策ではありませんが、必要なすべての情報にアクセスする方法を示す必要があります。

私には1つの問題がありました。 Set OutApp = CreateObject("Outlook.Application")でもSet OutApp = New Outlook.Applicationも、既に開いている場合はOutlookの新しいインスタンスを作成しません。したがって、Quitは、マクロが開始する前に開いていたかどうかにかかわらず、Outlookを閉じます。この問題について新しい質問を投稿することをお勧めします。私は誰かがOutlookが既に開いているので、それを終了しないように指示する方法を知っていると確信しています。

トップレベルのフォルダの種類がFoldersで、すべてのサブフォルダの種類がMAPIFolderであるため、Outlookのフォルダ構造はやや厄介です。あなたがそれを過ぎたら、それはかなり簡単です。

以下のコードには、機能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()は、メッセージの選択されたプロパティ、Subject、To、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