ExcelとOutlookの連携 パート2



The following two tabs change content below.
アバター

taka

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

ExcelとOutlookの連携 パート2

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

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

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

 

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

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

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

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

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

参考サイト

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

プログラムコード

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

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

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

 

ダウンロード

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

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

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

https://yb-log.com/

■Twitterフォロー

■YouTubeチャンネル登録

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

サンプルコードなどは当サイトの免責事項をよくお読みになってからお使いください。

Sponsored Link

 

WordPressでブログを始めるなら

WordPress簡単インストール&安心の安定性

レンタルサーバー Xserver

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です