ExcelとOutlookの連携　パート2

The following two tabs change content below.

• この記事を書いた人
• 最新の記事

taka

あることがキッカケでVBAを独学で勉強しました、今ではブログを通してVBAでできることを解説しつつ、VBAや他の言語の勉強、ブログ運営の勉強をしています(^^♪

最新記事 by taka (全て見る)

• 『雑記』最近の私の話～ - 2019年9月26日
• 【動画】自作パソコン構成変更！ケースをNZXT　H500に交換しました！ - 2019年6月5日
• VBA 『Array関数』指定した要素で配列を作成する - 2019年5月23日
• 「動画」初完全ワイヤレスイヤホン『Jabra Elite Active 65t』 - 2019年5月17日
• VBA　日付で令和を簡単に判定してみよう - 2019年5月7日

ExcelとOutlookの連携　パート2

すんごい久しぶりの企画です(笑)確認したら3/19に一度ご紹介しただけだったんですね～

長らくお待たせしてしまいまして申し訳ありません。

ですがこれには訳があります。

実は私のPCにはOutlookが入っていないのです|дﾟ)

なので会社の休憩時間に趣味で作成しているレベルですのでご了承ください。

ExcelVBAでOutlookのメールを移動する方法

という訳で今回はExcelVBAを使用してOutlookのメールを件名によってフォルダ分けをするプログラムを書いてみました。

※これは他サイト様のコードを参考にして作成ました。

参考サイト

1. AB型の変わり者 三流プログラマー Ken3のＨＰ　様

プログラムコード

さて、という事でプログラムコードは以下の通りなります。とりあえず解説はコメントとして記述しておきます。

※指定したフォルダーがない場合はエラーになりますので注意してください(。-∀-)

Sub sample()

    Dim OkApp As Object  'OKはOutlookの略(笑)
     Dim myNameSpace As Object
      Dim myFolder As Object
       Dim Sports As Object
        Dim MyInbox As Object
         Dim PrivateFolder As Object
          Dim MyExplorer As Object
           Dim MySelection As Object
            Dim mailitem As Object
              Dim i As Long

  
    Set OkApp = CreateObject("Outlook.Application") 'Outlook 起動
    
    Set myNameSpace = OkApp.GetNamespace("MAPI") '空間の指定？実際サポートしているのは【MAPI】だけの模様

    Set myFolder = myNameSpace.GetDefaultFolder(6) 'フォルダーの指定(6)が受信トレイ(5)が送信済みのアイテム、
    
    myFolder.display  'Outlookの画面を表示
     
     
     Set MyInbox = myNameSpace.GetDefaultFolder(6) '←移動元である受信トレイ
     
     Set PrivateFolder = MyInbox.Folders("移動先") 'メールの移動先を【移動先】フォルダーに指定
      
      For i = myFolder.Items.Count To 1 Step -1 'メール件数を取得し変数【i】を1つずつ減らしていく
      
      Set mailitem = myFolder.Items(i)
      
If mailitem.Subject = ("ここに件名を入力") Then 'Subject(件名）で移動先判断
        
        Cells(i, 1).Value = mailitem.Body   '【.Body】はメール本文、本文をセルに転記
          
          Set PrivateFolder = MyInbox.Folders("移動先") 'メールの移動先を【移動先】フォルダーに指定
            
            Set MyExplorer = myFolder.Items(i)
      
      MyExplorer.Move PrivateFolder 'メールを移動
 
'-------二つ目の件名を指定する場合----　一応コメントアウト　-----
' ElseIf mailitem.Subject = ("ここに件名を入力") Then 'Subject(件名）で移動先判断
'        Cells(i, 2).Value = mailitem.Body   '【.Body】はメール本文、本文をセルに転記
'          Set PrivateFolder = MyInbox.Folders("移動先2") 'メールの移動先を【移動先2】フォルダーに指定
'            Set MyExplorer = myFolder.Items(i)
'      MyExplorer.Move PrivateFolder 'メールを移動
'--------------------------------------
 
 
Else '件名1or件名2意外だった場合の処理
       
       Cells(i, 3).Value = mailitem.Body   '【.Body】はメール本文、本文をセルに転記
         Set PrivateFolder = MyInbox.Folders("その他") 'メールの移動先を【その他】フォルダーに指定
          Set MyExplorer = myFolder.Items(i)
      MyExplorer.Move PrivateFolder 'メールを移動
 
End If
 
 
  Next i '繰り返す

End Sub

ダウンロード

当サイトの免責事項をお読みになってからお使いください。

Outlook×Excel2

1 ファイル 13.28 KB

ダウンロード

フォロー・チャンネル登録お願いします

VBA以外についてのブログはこちら↓

■Twitterフォロー

■YouTubeチャンネル登録

ファイルやコードの利用、WEBサイトの利用について

Sponsored Link