ExcelとOutlookの連携　パート2

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

1 ExcelとOutlookの連携　パート2

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

taka

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

ExcelとOutlookの連携　パート2

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

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

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

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

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

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

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

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

参考サイト

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

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 14.97 KB

Download

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

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

Twitterフォロー

Twitterもやってます(^^♪Excelについてはあまり触れませんがブログの更新のお知らせはツイートしています(^^♪

Twitterフォロー

Follow @takabou63

カテゴリーで絞る

月で探す

ExcelとOutlookの連携　パート2

taka

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