【VBA】一瞬で複数ユーザのOutlook予定表をExcelへ取り込む方法!

複数ユーザのOutlookの予定表に登録されている予定をExcelシートへ取り込んで一覧表にしたいことはないでしょうか。

そんな中で悩むことは、

・カンタンに複数のメンバのOutlook予定表を一覧化する方法はどれ?
・Excelにメンバの予定をまとめたいのだけど、Outlookからの一括取得の方法はなに?

ではないでしょうか?

今回は、

・VBAで複数ユーザのOutlook予定表を一瞬でExcelへ取り込む方法
・オプションで期間指定や抽出文字条件を設定をする方法

についてまとめます!

タカヒロ
タカヒロ
業務の見える化にもつなげられますね。

複数ユーザのOutlook予定表を一瞬でExcelへ取り込む方法について

前回、「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」をご紹介しましたが、

読者の方から複数ユーザのOutlook予定情報をまとめて取得できないか

ご要望がありましたので、その操作ができるように機能を変更してみました。

利用ケースとしては、

中間管理職層の方やチームリーダが所属メンバのスケジュールを確認すること

が想定されます。

タカヒロ
タカヒロ
数名のメンバのスケジュールならどうにか把握はできそうですが、数十名となるとなかなか厳しいものがありますよね。

このツールを使えば、メンバが数十名だろうがワンクリックで対象者のスケジュールが一覧化できますし、

いわゆる業務の見える化や可視化といわれるものに貢献できるかなと思っています。

では機能の説明をしたいと思います。

今回のVBAの実装先は、これまでと同様Excelブック側となります。

Excel側に取得したいメンバリスト(メールアドレス)シート予定表が入る空のシートを用意し、

メンバリストに記載されているメールアドレスをキーにしてOutlook側の予定表を検索、取得し、Excelの空シートへ予定表が入力されるといった流れとなります。

Excelブック(VBA)のメンバリストからメールアドレスを取得
Excelブック(VBA) → このメアドの人の予定一覧ちょうだい → Outlook
Excelブック ← メアドの予定一覧を出すよ ← Outlook
①に戻りメンバリスト件数分処理を繰り返す

では早速実装をして動かしてみましょう!

Excel VBAからOutlookを操作するための下準備

①まずExcelを起動し、「開発」タブをクリックします。

②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。

③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。

以上です。

VBAを実装する

続いてVBAを実装します。

今回VBAは以下の通りとなります。

VBAは前回の「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」をベースに、

複数ユーザ分処理を繰り返すよう機能を追加・変更したものとなります。

Sub 複数の他人のOutlook予定表をExcelへ取り込む() 
  
    Dim strAddress As String 
    Dim strStart As String 
    Dim strEnd As String 
    Dim n As Integer 
  
    'Excelのブックとワークシートのオブジェクトを設定します。 
    Set wbBook = ThisWorkbook 
    Set wsSheet1 = wbBook.Worksheets(1) 
    Set wsSheet2 = wbBook.Worksheets(2) 
     
  
    '対象予定表の抽出期間を指定します。※変更する場合は以下の日付を変更してください。 
    strStart = Format("2020/09/1", "yyyy/mm/dd") '抽出するスケジュールの開始日を指定 
    strEnd = Format("2020/09/1", "yyyy/mm/dd") '抽出するスケジュールの終了日を指定 
     
  
    '1番目のシートの1行目にタイトルを記述します。 
    With wsSheet1 
        .Range("A1").CurrentRegion.Clear 
        .Cells(1, 1).Value = "件名" 
        .Cells(1, 2).Value = "場所" 
        .Cells(1, 3).Value = "開始日時" 
        .Cells(1, 4).Value = "終了日時" 
        .Cells(1, 5).Value = "予定の本文" 
        .Cells(1, 6).Value = "予約者" 
        .Cells(1, 7).Value = "必須出席者" 
        .Cells(1, 8).Value = "任意出席者" 
        .Cells(1, 9).Value = "EntryID" '予定のID※編集時にキーとして使用します。 
        .Cells(1, 10).Value = "定期的な予定" '定期的な予定であるかのフラグ。定期的な予定はTrue。 
        .Cells(1, 11).Value = "対象者(メアド)" 
         
        With .Range("A1:Z1") 
            .Font.Bold = True 
            .Font.ColorIndex = 10 
            .Font.Size = 11 
        End With 
    End With 

    strEnd = DateAdd("d", 1, strEnd)   ' 1日追加 
     
    '対象ユーザが記載されているメアド分予定表取り込み処理を繰り返します。 
    For n = 2 To wsSheet2.Cells(1048576, 1).End(xlUp).Row 
     
        With wsSheet2 
           Call 他人のOutlook予定表予定をExcelへ取り込む(.Cells(n, 1).Value, strStart, strEnd) 
        End With 
     
    Next 
     
    MsgBox "Outlook予定表の取り込みが完了しました!", vbInformation 
     
    'Null out the variables. 
    Set wbBook = Nothing 
    Set wsSheet1 = Nothing 
    Set wsSheet2 = Nothing 
     
End Sub 
  
  
  
Sub 他人のOutlook予定表予定をExcelへ取り込む(strAddress As String, strStart As String, strEnd As String) 
  
    'Outlook用の定義 
    Dim olApp As Outlook.Application 
    Dim olNamespace As Outlook.Namespace 
    Dim olFolder As Folder 
    Dim olConItems As Outlook.Items 
    Dim olItem  As AppointmentItem 
  
    'Excel用の定義 
    Dim wbBook As Workbook 
    Dim wsSheet As Worksheet 
    Dim lnContactCount As Long 
     
    '他人予定表の定義 
    Dim recOther As Recipient 
    Dim objAppt As AppointmentItem 
  
    
    Dim strDummy As String 
     
    '処理速度優先のためスクリーンの更新は行われません。 
    Application.ScreenUpdating = False 
     
  
     
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。 
    Set olApp = New Outlook.Application 
    Set olNamespace = olApp.GetNamespace("MAPI") 
    '他人のオブジェクトを指定し取得します。 
    Set recOther = olNamespace.CreateRecipient(strAddress) 
    '取得した他人のオブジェクトの内、予定表のみ絞り込み再取得します。 
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar) 
    Set olConItems = olFolder.Items 
  
  
    'ブックおよび、1番目のシート情報を取得します。 
    Set wbBook = ThisWorkbook 
    Set wsSheet1 = wbBook.Worksheets(1) 
     
    '取得結果を記述する行番号を指定します。 
    lnContactCount = wsSheet1.Cells(1048576, 1).End(xlUp).Row + 1 
     
  
   '開始日でソートします。 
   olConItems.Sort "[Start]" 
    
   'Trueで定期的な予定を含むようにします。※Falseであると定期的な予定は含まれません。 
   olConItems.IncludeRecurrences = True 
     
    'Findメソッドで期間指定して抽出するスケジュールを絞り込みます。 
    Set olItem = olConItems.Find("[End] < """ & strEnd & """ AND [Start] >= """ & strStart & """") 
     
     
     
    While TypeName(olItem) = "AppointmentItem" 
        'Findで検索すると期間範囲外の余計なものまでヒットしてしまうので、再度フィルタリングします。 
        If olItem.Start >= strStart And olItem.End < strEnd Then 
            With olItem 
                wsSheet1.Cells(lnContactCount, 1).Value = .Subject 
                wsSheet1.Cells(lnContactCount, 2).Value = .Location 
                wsSheet1.Cells(lnContactCount, 3).Value = .Start 
                wsSheet1.Cells(lnContactCount, 4).Value = .End 
                wsSheet1.Cells(lnContactCount, 5).Value = .Body 
                wsSheet1.Cells(lnContactCount, 6).Value = .Organizer 
                wsSheet1.Cells(lnContactCount, 7).Value = .RequiredAttendees 
                wsSheet1.Cells(lnContactCount, 8).Value = .OptionalAttendees 
                wsSheet1.Cells(lnContactCount, 9).Value = .EntryID 
                wsSheet1.Cells(lnContactCount, 10).Value = .IsRecurring 
                wsSheet1.Cells(lnContactCount, 11).Value = strAddress 
            End With 
            lnContactCount = lnContactCount + 1 
        End If 
        Set olItem = olConItems.FindNext 
    Wend 
     
    'Null out the variables. 
    Set olItem = Nothing 
    Set olConItems = Nothing 
    Set olFolder = Nothing 
    Set olNamespace = Nothing 
    Set olApp = Nothing 
    Set wbBook = Nothing 
    Set wsSheet1 = Nothing 
     
    'Turn screen updating back on. 
    Application.ScreenUpdating = True 
     
  
     
End Sub 

実装手順は以下の通りです。

今回はExcel側にこのVBAを実装します。

①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のVBAを入力します。

こちらで完了です。

テストデータを準備する

予定表取得対象者のメールアドレスをExcelへまとめる

今回のマクロはExcel側にまとめた予定表取得対象者のメールアドレスを読み込み、予定表を取得する処理となるため、

Excel側に予定表取得対象者のメールアドレスをまとめる必要があります。

まず、Excelに2つのシートを用意します。

シート名は何でもよいですが、必ず2つ目のシートにメールアドレスを入力してください。

入力開始位置はA2セルとなります。

タカヒロ
タカヒロ
大量に投入するとマクロの処理時間が長くなりますので、はじめは2~3名程度でテストし、徐々に増やすほうがよいでしょう。

なお、予定表取得対象者のメールアドレスですが、同じドメインに参加しているユーザのメールアドレス
マクロを実行する人は対象者の予定が参照できる権限を保持している必要がありますので、ご注意ください。

取得したい予定の期間を指定する

次に取得したい予定の期間を指定します。
サンプルでは開始日、終了日ともに2020/09/1となっていますので、
こちらを変更するようにお願いします。

strStart = Format(“2020/09/1“, “yyyy/mm/dd”) ‘抽出するスケジュールの開始日を指定
strEnd = Format(“2020/09/1“, “yyyy/mm/dd”) ‘抽出するスケジュールの終了日を指定

タカヒロ
タカヒロ
対象期間は1~3日が適正です。

こちらで、テストデータの準備は完了です。

VBAを実行する

ExcelからOutlook予定表の単体の予定を変更する

では早速VBAの実行をしてみましょう。

①「開発」タブの「VBA」をクリックし「複数の他人のOutlook予定表をExcelへ取り込む」を選択し、「実行」をクリックします。

②「Outlook予定表の取り込みが完了しました!」が表示されたら完了です。

Outlook予定表がExcelへ取り込まれていることが確認できましたね!

<追記>複数の他人のOutlook予定表をExcelへ取り込むVBA–時間指定バージョン

上記のVBAでは、期間指定の際、日付までの指定しかできない仕様であるので、
0時開始の“終日イベント”が抜け落ちてしまう場合がありました。

予定表の上部にでるアイテムが終日イベントとなります。

そこで、期間指定の日付に時間を加えて、終日イベントの抜け落ちを防ぎ、より詳細な期間指定ができるよう改良したものを公開したいと思います。

タカヒロ
タカヒロ
読者様より不具合とその対応までご教示いただきました。
ありがとうございます。

Sub 複数の他人のOutlook予定表をExcelへ取り込む_時間指定追加版()
  
    Dim strAddress As String
    Dim strStart As String
    Dim strEnd As String
    Dim n As Integer
  
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet1 = wbBook.Worksheets(1)
    Set wsSheet2 = wbBook.Worksheets(2)
     
  
    '対象予定表の抽出期間を指定します。※変更する場合は以下の日付を変更してください。
    strStart = Format("2021/1/1 00:00", "yyyy/mm/dd hh:nn") '抽出するスケジュールの開始日+時刻を指定
    strEnd = Format("2021/1/25 10:30", "yyyy/mm/dd hh:nn")   '抽出するスケジュールの終了日+時刻を指定
    
  
    '1番目のシートの1行目にタイトルを記述します。
    With wsSheet1
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "件名"
        .Cells(1, 2).Value = "場所"
        .Cells(1, 3).Value = "開始日時"
        .Cells(1, 4).Value = "終了日時"
        .Cells(1, 5).Value = "予定の本文"
        .Cells(1, 6).Value = "予約者"
        .Cells(1, 7).Value = "必須出席者"
        .Cells(1, 8).Value = "任意出席者"
        .Cells(1, 9).Value = "EntryID" '予定のID※編集時にキーとして使用します。
        .Cells(1, 10).Value = "定期的な予定" '定期的な予定であるかのフラグ。定期的な予定はTrue。
        .Cells(1, 11).Value = "対象者(メアド)"
        .Cells(1, 12).Value = "終日イベント"
         
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
     
    '対象ユーザが記載されているメアド分予定表取り込み処理を繰り返します。
    For n = 2 To wsSheet2.Cells(1048576, 1).End(xlUp).Row
    
    Debug.Print wsSheet2.Cells(n, 1).Value
    Debug.Print strStart
    Debug.Print strEnd
     
        With wsSheet2
           Call 他人のOutlook予定表予定をExcelへ取り込む(.Cells(n, 1).Value, strStart, strEnd)
        End With
     
    Next
     
    MsgBox "Outlook予定表の取り込みが完了しました!", vbInformation
     
    'Null out the variables.
    Set wbBook = Nothing
    Set wsSheet1 = Nothing
    Set wsSheet2 = Nothing
     
End Sub
  
  
  
Sub 他人のOutlook予定表予定をExcelへ取り込む(strAddress As String, strStart As String, strEnd As String)
  
    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Folder
    Dim olConItems As Outlook.Items
    Dim olItem  As AppointmentItem
  
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long
     
    '他人予定表の定義
    Dim recOther As Recipient
    Dim objAppt As AppointmentItem
  

    Dim strDummy As String
     
    '処理速度優先のためスクリーンの更新は行われません。
    Application.ScreenUpdating = False
     
  
     
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    '他人のオブジェクトを指定し取得します。
    Set recOther = olNamespace.CreateRecipient(strAddress)

    '取得した他人のオブジェクトの内、予定表のみ絞り込み再取得します。
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)

    Set olConItems = olFolder.Items
  
  
    'ブックおよび、1番目のシート情報を取得します。
    Set wbBook = ThisWorkbook
    Set wsSheet1 = wbBook.Worksheets(1)
     
    '取得結果を記述する行番号を指定します。
    lnContactCount = wsSheet1.Cells(1048576, 1).End(xlUp).Row + 1
     
  
    '開始日でソートします。
    olConItems.Sort "[Start]"
    
    'Trueで定期的な予定を含むようにします。※Falseであると定期的な予定は含まれません。
    olConItems.IncludeRecurrences = True
     
     
    'Findメソッドで期間指定して抽出するスケジュールを絞り込みます。
    Set olItem = olConItems.Find("[End] <= """ & strEnd & """ AND [Start] >= """ & strStart & """")
     
     
    While TypeName(olItem) = "AppointmentItem"
    
        'Findで検索すると期間範囲外の余計なものまでヒットしてしまうので、再度フィルタリングします。
        If olItem.Start >= strStart And olItem.End <= strEnd Then
            With olItem
                wsSheet1.Cells(lnContactCount, 1).Value = .Subject
                wsSheet1.Cells(lnContactCount, 2).Value = .Location
                wsSheet1.Cells(lnContactCount, 3).Value = .Start
                wsSheet1.Cells(lnContactCount, 4).Value = .End
                wsSheet1.Cells(lnContactCount, 5).Value = .Body
                wsSheet1.Cells(lnContactCount, 6).Value = .Organizer
                wsSheet1.Cells(lnContactCount, 7).Value = .RequiredAttendees
                wsSheet1.Cells(lnContactCount, 8).Value = .OptionalAttendees
                wsSheet1.Cells(lnContactCount, 9).Value = .EntryID
                wsSheet1.Cells(lnContactCount, 10).Value = .IsRecurring
                wsSheet1.Cells(lnContactCount, 11).Value = strAddress
                wsSheet1.Cells(lnContactCount, 12).Value = .AllDayEvent

            End With
            lnContactCount = lnContactCount + 1
        End If

        Set olItem = olConItems.FindNext
        
    Wend
    
     
    'Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set wbBook = Nothing
    Set wsSheet1 = Nothing
     
    'Turn screen updating back on.
    Application.ScreenUpdating = True
     
End Sub

変更した箇所は以下の通りです。

対象予定表の抽出期間の指定を日にちのみから日時へ変更するため、”yyyy/mm/dd hh:nn“のフォーマットとしました。

ですので、期間指定の際は”2021/1/1 00:00″のように時間を含むようにお願いします。

strStart = Format(“2021/1/1 00:00”, “yyyy/mm/dd hh:nn“) ‘抽出するスケジュールの開始日+時刻を指定
strEnd = Format(“2021/1/25 10:30”, “yyyy/mm/dd hh:nn“) ‘抽出するスケジュールの終了日+時刻を指定

また、終日イベントは0時始まりですので、抽出開始日に終日のイベントがある場合は「strStart」を0時から指定するようお願いします。

サンプルは、Outlookの予定表へ2021/1/1に終日のイベントをいれており、

前バージョンですと終日のイベントは抜け落ちますが、

このバージョンを実行すると、終日イベントが含まれていることが確認できました。

なお、終日のイベントであるかどうかを判断するために、

AllDayEventプロパティを取得するように追加をしています。

wsSheet1.Cells(lnContactCount, 12).Value = .AllDayEvent

AllDayEventプロパティが「True」の場合、終日イベントであるという判定となります。

取得した値を確認してみると、

True」になっていることが確認できましたね!

<追加>複数の他人のOutlook予定表を取り込む際に、特定の文字を含む件名のみに絞り込む方法

読者の方よりOutlook予定表を取り込む際に特定の文字を含む件名に絞り込む方法について質問がありましたので、

対応方法について追記いたします。

サンプルコードの以下箇所を変更します。

変更前

If olItem.Start >= strStart And olItem.End <= strEnd Then

変更後

If olItem.Start >= strStart And olItem.End < strEnd And olItem.Subject Like “*<ここに抽出したい文字を入力>*” Then

Like演算子と半角ワイルドカード「*」を使う方法です。

例えば「【重要】〇〇〇検討のこと」など「重要」を含む件名のみ抽出したい場合は、

If olItem.Start >= strStart And olItem.End < strEnd And olItem.Subject Like “*重要*” Then

のようにします。

タカヒロ
タカヒロ
ワイルドカードは全角では効かないので、かならず半角にしてください。

さいごに

いかがでしょうか。

今回は

・VBAで複数ユーザのOutlook予定表を一瞬でExcelへ取り込む方法
・オプションで期間指定や抽出文字条件を設定をする方法

についてまとめました。

まだまだ便利な方法がりますので、よろしければご参照頂ければと思います。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。



タカヒロ

タカヒロ
Excelの基礎がスルスル入ってくるAmazonランク1位の優良Excel本です。

この基礎本と応用技が多いエク短と組み合わせれば、短時間で誰よりもExcelが使いこなせるかと思います。
>詳細を見てみる 

54 件のコメント

  • 返信遅くなりまして申し訳ありません。ご確認いただきありがとうございした。
    取得対象者を「すべての詳細を表示可能」に変更することが難しい状況です。
    (幹部クラスの人間の予定が含まれ、情報セキュリティ的にアウト)

    今後、折を見てアクセス許可レベル「タイトルと場所の表示が可能」の状況でも
    予定表を取得できることが出来た際には記事にしたいただければ幸いです。

    • ご連絡ありがとうございます。

      すべての参照権限を付与することが難しい状況であること承知いたしました。
      もし他の方法があるようでしたら追記させて頂きます。

  • 有益な情報をありがとうございます。
    ご質問ですが、予定表のアクセス許可レベルが「タイトルと場所の表示が可能」
    の人の予定表を取得することはできないでしょうか?
    件名、開始日時、終了日時、対象者(メアド)のみが必要で、前述のコメントを参考に出力する項目を絞り、自身の予定表を出力することはできましたグループ内の他人の予定を出力することが出来ませんでした。
    私の見落としで、既に回答済みの質問であればお手を煩わせて恐縮ですが、
    ご確認いただければ幸いです。

    • いつもご利用ありがとうございます。

      「タイトルと場所の表示が可能」のアクセス権がある他人の予定表を出力できるかにつきまして、
      こちらでも検証しましたところ、予定表情報取得のところでエラーとなり、アイテムの取得はできない状況でした。

      推測ですが、VBAでは一旦全項目、全アイテムの予定表情報を取得する仕様であるため、アクセス権がない方(つまりタイトルと場所以外の項目)の権限が優先され、
      取得不可になったといったことが考えられます。

      ですので、お手数ではございますが、
      取得対象の予定表のアクセス権を「すべての詳細を表示可能」に設定いただければと存じます。

  • こんにちは
    大変参考になりました。

    大変初歩的な質問なのですが、
    strStart = Format(“2021/1/1 00:00”, “yyyy/mm/dd hh:nn”)
    strEnd = Format(“2021/1/25 10:30”, “yyyy/mm/dd hh:nn”)
    のところで、別シートのセルに日時を入力して
    開始日時をA1、終了日時をB1 としたいとき
    はどのように書き換えればいいのでしょうか?

    お手数をおかけしますがご教授いただけますと幸いです。
    よろしくお願いいたします。

    • いつもご利用ありがとうございます。

      別シートにて開始日時、終了日時を指定する件ですが、
      別シート名を「Sheet4」、開始日時をA1、終了日時をB1 とする場合、
      strStart = Format(wbBook.Worksheets(“Sheet4”).Range(“A1”).Value, “yyyy/mm/dd hh:nn”)
      strEnd = Format(wbBook.Worksheets(“Sheet4”).Range(“B1”).Value, “yyyy/mm/dd hh:nn”)
      のようにして頂ければと存じます。

  • 非公開の予定の出力について、
    おかげ様で期待する動きを実現できました。
    ありがとうございます。非常に助かりました。

  • 連投失礼します。
    質問が誤っておりましたので、修正させて頂きます。

    ★非公開の予定はエクスポートしない。

    制御がややこしい場合は、当初の質問とおり下記を実現したいです。

    非公開の予定の場合は、下記の通りエクスポートしたいですが、
    どこをどう変更すれば実現できますでしょうか。
    ・件名「非公開」
    ・予定の本文「(空白)」
    教えてください。

    • いつもご利用ありがとうございます。

      予定が非公開である場合の処理につきまして、Sensitivityプロパティにより判定が可能となります。

      Sensitivityプロパティは非公開の場合2(又はolPrivate)を持ちますので、
      非公開の予定をエクスポートさせない場合はSensitivityが2でないアイテムを出力する条件にします。

      具体的には以下のようにします。

      ■変更前
      If olItem.Start >= strStart And olItem.End <= strEnd Then

      ■変更後
      If olItem.Start >= strStart And olItem.End <= strEnd And Not olItem.Sensitivity = 2 Then

      また、
      ・件名「非公開」
      ・予定の本文「(空白)」
      とする場合は、同じく非公開判定の条件を加え件名、本文の出力処理を分ければよいです。
      If olItem.Sensitivity = 2 Then
      wsSheet1.Cells(lnContactCount, 1).Value = “非公開” ‘・件名「非公開」
      wsSheet1.Cells(lnContactCount, 5).Value = “” ‘・予定の本文「(空白)」
      Else
      wsSheet1.Cells(lnContactCount, 1).Value = .Subject
      wsSheet1.Cells(lnContactCount, 5).Value = .Body
      End If

      よろしくお願いいたします。

  • 非公開の予定の場合は、下記の通りエクスポートしたいですが、
    どこをどう変更すれば実現できますでしょうか。
    ・件名「非公開」
    ・予定の本文「(空白)」
    教えてください。

    • いつもご利用ありがとうございます。

      ご質問の終日の予定のみ&指定の文字を含む形で出力する方法ですが、
      コード内の条件式を以下のようにすることで対応可能です。

      ■変更前
      If olItem.Start >= strStart And olItem.End = strStart And olItem.End <= strEnd And olItem.AllDayEvent And InStr(olItem.Subject, “Test”) Then

      終日の予定を示すolItem.AllDayEventがTrueであり、かつ件名に”Test”が含まれる場合に対象となるような条件となります。
      “Test”の部分は用途に合わせて変更頂ければと思います。

      また件名ではなく本文内を部分一致させたい場合は「olItem.Subject」を「olItem.Body」へ変更してください。

      よろしくお願いいたします。

  • コメントを残す

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