作成しようとしている予定に重複する予定がないかを確認するマクロ


コメントにて以下のご要望をいただきました。


お世話になっております。はじめてコメントさせて頂きます。

こちらのサイトを参考にして、Excel VBA 2010経由でOutlook予定表のイベント登録のマクロを
作成させて頂きました。大変重宝しております。ありがとうございます。

その後、機能追加を考えております。内容は現状、イベント登録マクロを実行する前に登録しようと
している日時や共有フォルダ内に別のイベントが登録されていないかを目視で確認した上、マクロを
実行している運用です。

これを目視で事前のイベント登録の確認をしなくてもマクロを実行した時に、登録しようとしている
日時や共有フォルダの空き状況チェックをかけて、空いていればイベント登録、空いていなければ
メッセージを返すような事は出来ないでしょうか。

手動で予定表のイベントを作成する時に、同じ時間帯に同じ共有フォルダ内に既にイベントが存在
すれば、イベント登録画面で「この時間帯に別の予定が入っています。」というメッセージがウインドウ
内に表示されるので何かしらのチェックはかけられると考えています。

お手数ですが、事前チェック機能を追加する為にどのようなマクロを追記すれば良いかご教授頂きたいです。



登録処理を行う前に、その予定が入る時間帯に別の予定がないかどうかを検索することで、重複チェックは可能です。
予定を登録するマクロは作成されているようですので、重複チェックを行う部分を関数として実装してみました。
CheckExists の最初のパラメータに予定を作成するフォルダー、次にパラメータに作成する予定の開始日、最後のパラメータに作成する予定の終了日を指定すると、重複する予定がある場合は True を、無ければ False を返します。
関数は以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Function CheckExists(fldCalendar As Variant, dtStart As Date, dtEnd As Date)
    Dim colItems 'As Items
    Dim strFilter 'As String
    Dim itmFind 'As AppointmentItem
    '
    Set colItems = fldCalendar.Items
    colItems.Sort "開始日"
    colItems.IncludeRecurrences = True
    strFilter = "[End] > """ & Format(dtStart, "yyyy/mm/dd HH:MM") & _
    """ and [Start] < """ & Format(dtEnd, "yyyy/mm/dd HH:MM") & """"
    Set itmFind = colItems.Find(strFilter)
    If Not itmFind Is Nothing Then
        MsgBox "重複する予定があります"
        CheckExists = True
    Else
        CheckExists = False
    End If
End Function

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中