Outlookのメールに基づいてExcelシートを更新

Question

私の目的は、特定の件名のメールを受信するたびにExcelシートを更新することです（関連するメールをフォルダに移動するルールを設定しました）。

私はこのサイトで同様の投稿を見ましたが、指定されたコードは完全ではありません。 'pro'や 'techie'ではなく、コードを書くことが非常に難しい。

メールが含まれています

ファイル名： 所有者名： 最終更新日： ファイルlocaion（これは、共有ドライブのパスになります）：

を私は毎日このメールを取得し、これを更新する必要があります情報がExcelシートに表示されます。 （私は月末まで開いています）

私を助けてください。おかげでこの答えの最初のバージョンで事前

Answer 1

はじめ

で、私は今あなたが読んですることはできません知っている別の質問にあなたを言及しました。

必要なコードはすべてここにありますが、これは直接の解決策として書かれていません。これは、Outlookオブジェクトモデルを紹介し、OutlookデータベースからExcelワークブックにデータを取得するチュートリアルです。あなたが「プロ」や「テク」ではないことを心配しないでください。かつて我々はすべての初心者だった。セクションを処理します。あなたがすべてを理解していなければ心配しないでください。今必要なビットを選んでください。ソリューションを強化する場合は、このチュートリアルとディスクにコピーしたコードに戻ってください。

以下のセクションでは、AnswerA（）とAnswerB（）は、フォルダ構造の理解を助けることを目的としています。 AnswerC1（）は短期間の訓練援助でもあります。ただし、AnswerC2（）とAnswerC3（）は、必要な場合があるサブルーチンです。あなたがそれらを保持している場合は、名前を変更することをお勧めします。たとえば、FindFolder（）およびFindFolderSub（）です。

AnswerD（）もトレーニングの援助ですが、あなたが保持する必要があります。これは、いくつかのメールアイテムプロパティにアクセスする方法を示していますが、私が示したものよりも多くのメールアイテムプロパティにアクセスする必要があるかもしれません。 VBエディタ内でF2をクリックして、オブジェクトエクスプローラを表示します。クラスのリストをMailItemまでスクロールします。 100以上のメソッドとプロパティのリストが表示されます。いくつかは明白ですが、VB Helpを使用して多くの目的を発見する必要があります。 AnswerD（）を展開して、便利かもしれないと思われるメソッドやプロパティを表示します。

Answer E（）は開発援助ですが、マクロの構造も提供します。現在は、フォルダ内のメールアイテムのtext bodyとhtml bodyをディスクに出力します。あなたは現時点でこれをしたくないが、そうかもしれない。すべてのメールをExcelにアーカイブします。送信者、受信者、件名、日付などの列を含む電子メールごとに1行を作成します。テキスト本文、HTML本文、ディスクへの添付ファイルを保存し、それらにハイパーリンクを作成します。私は複数のOutlookのインストールから数年前にメールを送ってきました。

AnswerF1（）は新しいExcelブックを作成する方法を示し、AnswerF2（）は既存のExcelブックを開く方法を示します。 AnswerF2（）が必要なものだと思います。

ここにはたくさんの項目がありますが、それを着実に実践すれば、Outlookオブジェクトモデルと目的を達成する方法を理解できます。この回答で

健康警告

すべてが実験によって発見されました。私はVB Helpから始めて、F2を使ってオブジェクトモデルにアクセスし、何がうまくいくかを見つけるまで実験しました。私は非常に推薦された参考書を購入しましたが、私が発見しなかった重要なことは何も含まれていませんでした。

私が得た知識の重要な特徴は、それが多くの異なるインストールに基づいていることです。遭遇した問題のいくつかは、インストールの間違いの結果であり、なぜ参考書の作者がそれらを知らなかったのかを説明しているかもしれない。 OutlookのVBA

を開き、 "見通し" や "展望所" に慣れていない場合

以下のコードがExcel 2003およびOutlook Exchange 2003および2007

でテストされていますが入門します。これらのマクロは「Outlook Express」では動作しません。

ツールバーから、[ツール]、[マクロ]、[セキュリティ]の順に選択します。セキュリティレベルがまだそのレベルにない場合は、セキュリティレベルを「中」に変更します。つまり、マクロを実行することはできますが、明示的な承認がある場合にのみ実行できます。

いずれかの見通しVBエディタを起動するには：

1）ツールバーで、[ツール]、マクロから、マクロ か、Alt + F11 2をクリックしてください）マクロを有効にする]を選択。

ツールバーから、[挿入]、[モジュール]を選択します。

1つ、2つまたは3つのウィンドウが表示されます。左側をプロジェクトエクスプローラにします。今日は必要ありませんが、欠けている場合はCtrl + Rを押して表示してください。右側には、コードを配置する領域が表示されます。下部にイミディエイトウィンドウが表示されます。イミディエイトウィンドウがない場合は、Ctrl + Gを押して表示します。以下のすべてのマクロはイミディエイトウィンドウを使用して出力しますので、表示できる必要があります。

カーソルがコード領域に表示されます。

Enter：Option Explicit。

これは、VBエディタにすべての変数が定義されていることを確認するように指示します。以下のコードはテストされていますが、入力できるコードには1種類のエラーがありません。

下記のマクロをコピーしてコード領域に貼り付けてください。

マクロマクロを実行する前に、AnswerC（）、AnswerD（）、Answer（E）、AnswerF1（）、AnswerF2（）を変更する必要があります。マクロ内の命令。

マクロを実行するには、その中にカーソルを置きF5キーを押します。上の2つのフォルダレベル

にフォルダの最上位レベルへのアクセス

はタイプのフォルダです。すべてのサブフォルダはMAPIFolderタイプです。私は、サブフォルダにアクセスする手段としてではなく、トップレベルにアクセスしようとしたことはありません。

AnswerA（）はOutlook Exchangeデータベースにアクセスし、トップレベルのフォルダの名前をイミディエイトウィンドウに出力します。

​​

AnswerB（）は、トップレベルのフォルダとその直下の子の名前を出力します。

AnswerB（）の問題は、子供が子供に任意の深さの子供を持つことができるということです。どのような深さであっても特定のフォルダを見つけることができる必要があります。あなたは、このような「受信トレイ」またはあなたは、このコードを必要としない「送信済みアイテム」として、デフォルトのフォルダを検索したい場合は

という名前のフォルダ

を探します。テーブルを含むメッセージを別のフォルダにコピーする場合は、このコードが必要です。あなたがこのコードを今必要としないと決めたとしても、将来必要になる場合に備えることをお勧めします。

以下のコードでは、2つのサブルーチンを使用しています。呼び出し元は、「個人用フォルダ|メールボックス|受信トレイ」などのフォルダ名を組み立てます。サブルーチンは階層を処理し、必要なフォルダが見つかった場合はそれをオブジェクトとして返します。

注：「受信トレイ」や「送信アイテム」などの既定のフォルダを特定する特別なケースについては、後で説明します。

AnswerC2（）とAnswerC3（ターゲットフォルダを調べる

Sub AnswerC1() 

    ' This routine wants a folder. It does nothing but display its name. 

    Dim FolderNameTgt As String 
    Dim FolderTgt As MAPIFolder 

    ' The names of each folder down to the one required separated 
    ' by a character not used in folder names. 
    ' ############################################################## 
    ' Replace "Personal Folders|MailBox|Inbox" with the name 
    ' of one of your folders. If you use "|" in your folder names, 
    ' pick a different separator and change the call of AnswerC2(). 
    ' ############################################################## 
    FolderNameTgt = "Personal Folders|MailBox|Inbox" 

    Call AnswerC2(FolderTgt, FolderNameTgt, "|") 
    If FolderTgt Is Nothing Then 
    Debug.Print FolderNameTgt & " not found" 
    Else 
    Debug.Print FolderNameTgt & " found: " & FolderTgt.Name 
    End If 

End Sub 

Sub AnswerC2(ByRef FolderTgt As MAPIFolder, NameTgt As String, NameSep As String) 

    ' This routine initialises the search and finds the top level folder 

    Dim InxFolderCrnt As Integer 
    Dim NameChild As String 
    Dim NameCrnt As String 
    Dim Pos As Integer 
    Dim TopLvlFolderList As Folders 

    Set FolderTgt = Nothing ' Target folder not found 

    Set TopLvlFolderList = _ 
      CreateObject("Outlook.Application").GetNamespace("MAPI").Folders 

    ' Split NameTgt into the name of folder at current level 
    ' and the name of its children 
    Pos = InStr(NameTgt, NameSep) 
    If Pos = 0 Then 
    ' I need at least a level 2 name 
    Exit Sub 
    End If 
    NameCrnt = Mid(NameTgt, 1, Pos - 1) 
    NameChild = Mid(NameTgt, Pos + 1) 

    ' Look for current name. Drop through and return nothing if name not found. 
    For InxFolderCrnt = 1 To TopLvlFolderList.Count 
    If NameCrnt = TopLvlFolderList(InxFolderCrnt).Name Then 
     ' Have found current name. Call AnswerC3() to look for its children 
     Call AnswerC3(TopLvlFolderList.Item(InxFolderCrnt), _ 
              FolderTgt, NameChild, NameSep) 
     Exit For 
    End If 
    Next 

End Sub 

Sub AnswerC3(FolderCrnt As MAPIFolder, ByRef FolderTgt As MAPIFolder, _ 
             NameTgt As String, NameSep As String) 

    ' This routine finds all folders below the top level 

    Dim InxFolderCrnt As Integer 
    Dim NameChild As String 
    Dim NameCrnt As String 
    Dim Pos As Integer 

    ' Split NameTgt into the name of folder at current level 
    ' and the name of its children 
    Pos = InStr(NameTgt, NameSep) 
    If Pos = 0 Then 
    NameCrnt = NameTgt 
    NameChild = "" 
    Else 
    NameCrnt = Mid(NameTgt, 1, Pos - 1) 
    NameChild = Mid(NameTgt, Pos + 1) 
    End If 

    ' Look for current name. Drop through and return nothing if name not found. 
    For InxFolderCrnt = 1 To FolderCrnt.Folders.Count 
    If NameCrnt = FolderCrnt.Folders(InxFolderCrnt).Name Then 
     ' Have found current name. 
     If NameChild = "" Then 
     ' Have found target folder 
     Set FolderTgt = FolderCrnt.Folders(InxFolderCrnt) 
     Else 
     'Recurse to look for children 
     Call AnswerC3(FolderCrnt.Folders(InxFolderCrnt), _ 
              FolderTgt, NameChild, NameSep) 
     End If 
     Exit For 
    End If 
    Next 

End Sub 

）がターゲットフォルダを検索するためのコードを提供します。フォルダには、メールアイテム、会議出席依頼、連絡先、カレンダーエントリなどのアイテムが含まれます。メールアイテムのみがこのコードで検査されます。会議出席依頼へのアクセスは本質的に同じですが、異なるプロパティがあります。

AnswerD（）は、メールアイテムのプロパティの選択を出力します。

選択したフォルダに対してAnswerD（）を実行したら、F2キーを押すか、ツールバーの[表示] - [オブジェクトブラウザ]を選択します。 MailItemに到達するまで項目のリストを下にスクロールします。メンバーのエリアには、100を超えるすべてのプロパティとメソッドが表示されます。ほとんどの場合、VBヘルプを参照する必要があります。このルーチンを修正して、より多くのプロパティとメソッド、おそらくは他のタイプのアイテムを探索してください。

警告。このコードは、メールアイテムの名前付きフォルダを調べるように設計されています。フォルダ階層全体を探索するコードを修正すると、問題が発生することがあります。それは私の間違いだったかもしれないし、インストール時に欠陥があったかもしれないが、「RSSフィード」などの特定のフォルダにアクセスしようとするとコードがクラッシュすることがわかった。私はこれらのクラッシュを探索するのに十分なほど関心を持ってこなかったし、選択した名前のブランチを無視するようにツリー検索を単純に修正しただけです。

このマクロを実行すると、「プログラムがOutlookに格納されている電子メールアドレスにアクセスしようとしています。許可しますか？」という警告が表示されます。 「アクセスを許可」にチェックを入れ、間隔を選択して「はい」をクリックします。ディスクに遺体を保存する

Sub AnswerD() 

    Dim FolderItem As Object 
    Dim FolderItemClass As Integer 
    Dim FolderNameTgt As String 
    Dim FolderTgt As MAPIFolder 
    Dim InxAttach As Integer 
    Dim InxItemCrnt As Integer 

    ' ############################################################## 
    ' Replace "Personal Folders|MailBox|Inbox" with the name 
    ' of one of your folders. If you use "|" in your folder names, 
    ' pick a different separator and change the call of AnswerC2(). 
    ' ############################################################## 
    FolderNameTgt = "Personal Folders|MailBox|Inbox" 

    Call AnswerC2(FolderTgt, FolderNameTgt, "|") 
    If FolderTgt Is Nothing Then 
    Debug.Print FolderNameTgt & " not found" 
    Else 
    ' Display mail items, if any, within folder 
    Debug.Print "Mail items within " & FolderNameTgt 
    For InxItemCrnt = 1 To FolderTgt.Items.Count 
     Set FolderItem = FolderTgt.Items.Item(InxItemCrnt) 

     With FolderItem 

     ' This code seems to avoid syncronisation errors 
     FolderItemClass = 0 
     On Error Resume Next 
     FolderItemClass = .Class 
     On Error GoTo 0 

     If FolderItemClass = olMail Then 
      ' Display Received date, Attachment count and Subject 
      Debug.Print " Mail item: " & InxItemCrnt 
      Debug.Print " Received=" & Format(.ReceivedTime, _ 
         "ddmmmyy hh:mm:ss") & " " & _ 
         .Attachments.Count & _ 
         " attachments Subject = " & .Subject 
      Debug.Print " Sender: " & .SenderName 
      With .Attachments 
      ' If the are attachments display their types and names 
      If .Count > 0 Then 
       Debug.Print " Attachments:" 
       For InxAttach = 1 To .Count 
       With .Item(InxAttach) 
        Debug.Print "  Type="; 
        Select Case .Type 
        Case olByReference 
         Debug.Print "ByRef"; 
        Case olByValue 
         Debug.Print "ByVal"; 
        Case olEmbeddeditem 
         Debug.Print "Embed"; 
        Case olOLE 
         Debug.Print " OLE"; 
        End Select 
        Debug.Print " DisplayName=" & .DisplayName 
       End With 
       Next 
      End If 
      End With 
     End If 
     End With 
    Next InxItemCrnt 
    End If 

End Sub 

AnswerE（）任意のフォルダを検索し、その中にすべてのメールアイテムのテキストとhtml体のコピーを保存します。私はあなたが新しいフォルダにテーブルを含むメッセージの選択をコピーし、AnswerE（）を実行することをお勧めします。これはあなたの質問には直接関係しませんが、理解を助けると信じています。

このマクロを実行すると、「プログラムがOutlookに格納されている電子メールアドレスにアクセスしようとしています。許可しますか？」という警告が表示されます。 「アクセスを許可」にチェックを入れ、間隔を選択して「はい」をクリックします。

Sub AnswerE() 

    ' Output any Text or HTML bodies found within specified folder 

    Dim FolderItem As Object 
    Dim FolderItemClass As Integer 
    Dim FolderNameTgt As String 
    Dim FolderTgt As MAPIFolder 
    Dim FileSystem As Object 
    Dim FileSystemFile As Object 
    Dim HTMLBody As String 
    Dim InxAttach As Integer 
    Dim InxItemCrnt As Integer 
    Dim PathName As String 
    Dim TextBody As String 

    ' ############################################################## 
    ' Replace "Personal Folders|MailBox|Inbox" with the name 
    ' of one of your folders. If you use "|" in your folder names, 
    ' pick a different separator and change the call of AnswerC2(). 
    ' The folder you pick must have at least one mail item with an 
    ' HTML body for this macro to do anything. 
    ' ############################################################## 
    FolderNameTgt = "Personal Folders|MailBox|Inbox" 

    Call AnswerC2(FolderTgt, FolderNameTgt, "|") 
    If FolderTgt Is Nothing Then 
    Debug.Print FolderNameTgt & " not found" 
    Exit Sub 
    End If 

    ' #################################################################### 
    ' The following is an alternative method of accessing a default folder 
    ' such as Inbox. This statement would replace the code above. 
    ' Set FolderTgt = CreateObject("Outlook.Application"). _ 
    '   GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
    ' #################################################################### 

    ' Extract bodies if found 

    Set FileSystem = CreateObject("Scripting.FileSystemObject") 

    ' ############################################################## 
    ' Replace "C:\Email\" with the name of one of your folders 
    ' ############################################################## 
    PathName = "C:\Email\" 

    For InxItemCrnt = 1 To FolderTgt.Items.Count 
    Set FolderItem = FolderTgt.Items.Item(InxItemCrnt) 

    With FolderItem 

     ' This code seems to avoid syncronisation errors 
     FolderItemClass = 0 
     On Error Resume Next 
     FolderItemClass = .Class 
     On Error GoTo 0 

     If FolderItemClass = olMail Then 
     HTMLBody = Trim(.HTMLBody) 
     If HTMLBody <> "" Then 
      ' Save HTML body to disc. The file name is of the form 
      ' BodyNNN.html where NNN is a a sequence number. 
      ' First True in CreateTextFile => overwrite existing file. 
      ' Second True => Unicode format 
      Set FileSystemFile = FileSystem.CreateTextFile(PathName & _ 
        "Body" & Right("00" & InxItemCrnt, 3) & _ 
           ".html", True, True) 
      FileSystemFile.Write HTMLBody 
      FileSystemFile.Close 
     End If 
     TextBody = Trim(.Body) 
     If HTMLBody <> "" Then 
      ' Save text body to disc. The file name is of the form 
      ' BodyNNN.txt where NNN is a a sequence number. 
      Set FileSystemFile = FileSystem.CreateTextFile(PathName & _ 
        "Body" & Right("00" & InxItemCrnt, 3) & _ 
           ".txt", True, True) 
      FileSystemFile.Write TextBody 
      FileSystemFile.Close 
     End If 
     End If 
    End With 

    Next InxItemCrnt 

End Sub 

Excelブックを作成または更新する

新しいExcelブックを作成したり、既存のものを更新する場合は、言うことはありません。 AnswerF1（）はワークブックを作成します。 AnswerF2（）は既存のワークブックを開きます。あなたがしなければならないこれらのマクロのいずれかを試みる前に

ます。Outlook VBAエディタ内から

• を、ツールバーから[ツール]を選択します。
• 参照を選択します。
• Microsoft Excel 11.0 Object Libraryまでスクロールダウンして、ボックスにチェックマークを付けます。

。 Excelワークブック

このコードを使用すると、ワークブックの次の空きの行を検索し、それへの書き込みへの書き込み

Sub AnswerF1() 

    Dim xlApp As Excel.Application 
    Dim ExcelWkBk As Excel.Workbook 
    Dim FileName As String 
    Dim PathName As String 

    ' ############################################################## 
    ' Replace "C:\Email\" with the name of one of your folders 
    ' Replace "MyWorkbook.xls" with the your name for the workbook 
    ' ############################################################## 
    PathName = "C:\Email\" 
    FileName = "MyWorkbook.xls" 

    Set xlApp = Application.CreateObject("Excel.Application") 
    With xlApp 
    .Visible = True   ' This slows your macro but helps during debugging 
    Set ExcelWkBk = xlApp.Workbooks.Add 
    With ExcelWkBk 

     ' Add Excel VBA code to update workbook here 

     .SaveAs FileName:=PathName & FileName 
     .Close 
    End With 
    .Quit 
    End With 
End Sub 
Sub AnswerF2() 

    Dim xlApp As Excel.Application 
    Dim ExcelWkBk As Excel.Workbook 
    Dim FileName As String 
    Dim PathName As String 

    ' ############################################################## 
    ' Replace "C:\Email\" with the name of one of your folders 
    ' Replace "MyWorkbook.xls" with the your name for the workbook 
    ' ############################################################## 
    PathName = "C:\Email\" 
    FileName = "MyWorkbook.xls" 

    Set xlApp = Application.CreateObject("Excel.Application") 
    With xlApp 
    .Visible = True   ' This slows your macro but helps during debugging 
    Set ExcelWkBk = xlApp.Workbooks.Open(PathName & FileName) 
    With ExcelWkBk 

     ' Add Excel VBA code to update workbook here 

     .Save 
     .Close 
    End With 
    End With 
End Sub 

。私はなぜ定数が有用であるかを説明し、あなたのOutlookとExcelのコードを分けておくことについて警告します。

' Constants allow you alter the sequence of columns in your workbook without 
' having to change your code. Replace the 1, 2 and 3 in these statements 
' and the job is done. 
' !!! Constants must be above any subroutines and functions. 

Public Const ColFrom As Integer = 1 
Public Const ColSubject As Integer = 2 
Public Const ColSentDate As Integer = 3 

Sub AnswerG() 

    Dim RowNext As Integer 

    ' This code goes at the top of your macro 
    With Sheets("Sheet1")  ' Replace with the name of your worksheet 
    ' This finds the bottom row with a value in column A. It then adds 1 to get 
    ' the number of the first unused row. 
    RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1 
    End With 

    ' You will have to separate your Outlook and Excel code. 
    ' With Outlook 
    ' Var1 = .Body 
    ' Var2 = .ReceivedTime 
    ' Var3 = .SenderName 
    ' End With 
    ' With Excel 
    ' .Cell(R, C).Value = Var1 
    ' End With 

    With Sheets("Sheet1")  ' Replace with the name of your worksheet 

    .Cells(RowNext, ColFrom).Value = "John Smith" 
    .Cells(RowNext, ColSubject).Value = "Our meeting" 
    With .Cells(RowNext, ColSentDate) 
     .Value = Now() 
     ' This format means the time is stored and I can access it but it 
     'is not displayed. Change to "mm/dd/yy" or whatever you like. 
     .NumberFormat = "d mmm yy" 
    End With 
    RowNext = RowNext + 1 ' Ready for next loop 

    End With 

End Sub 

概要

私は細部の適切なレベルを提供している願っています。いずれかの方法でコメントを返信してください。

最後のマクロに飛び込まないでください。何かがうまくいかない場合は、原因を理解できません。以前の答えのそれぞれを試してみてください。若干違うことをしてください。

運のベスト。あなたはOutlookとVBAでどのくらい早く快適になるか驚くでしょう。