ナビゲーションウィンドウの予定表でチェックがついている他人の予定表をエクスポートするマクロ


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


Exchange 環境で共有されている他人の予定表のデータを取得するマクロ
を拝見させていただきました。

そのなかでユーザ名をインプットボックスから取得していますが、予定表にチェックがついているユーザのデータを取得する方法はありますでしょうか


予定表のナビゲーション モジュールは ActiveExplorer.NavigationPane.Modules.GetNavigationModule(olModuleCalendar) で取得可能です。
そして、取得したモジュールの NavigationGroups ごとに含まれる NavigationFolders のうち、IsSelected が True のフォルダーがチェックされているフォルダーとなります。
したがって、下記のようなマクロで実現が可能です。

' ここをトリプルクリックでマクロ全体を選択できます。
'
Public Sub ExportThisMonthCheckedCalendars()
    On Error Resume Next
    Dim navModCal As CalendarModule
    Dim navGroup As NavigationGroup
    Dim navFolder As NavigationFolder
    Set navModCal = ActiveExplorer.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
    For Each navGroup In navModCal.NavigationGroups
        For Each navFolder In navGroup.NavigationFolders
            If navFolder.IsSelected Then
                ExportOneUser navFolder.DisplayName
            End If
        Next
    Next
End Sub
'
' ユーザーごとのサブプロシージャ
Public Sub ExportOneUser(strUserName As String)
    Const CSV_FOLDER_NAME = "c:\calendar\" ' エクスポートするフォルダ名を指定してください。
    Dim objRecip As Recipient
    Dim fldCalendar As Folder
    Dim dtExport As Date
    Dim strStart As String
    Dim strEnd As String
    Dim objFSO 'As FileSystemObject
    Dim stmCSVFile 'As TextStream
    Dim colAppts As Items
    Dim objAppt 'As AppointmentItem
    Dim strLine As String
    ' 共有フォルダーかどうかを確認します。
    Set objRecip = Session.CreateRecipient(strUserName)
    objRecip.Resolve
    If Not objRecip.Resolved Then
        Exit Sub
    End If
    Set fldCalendar = Session.GetSharedDefaultFolder(objRecip, olFolderCalendar)
    If fldCalendar Is Nothing Then
        Exit Sub
    End If
    dtExport = Now ' 来月の予定をエクスポートする場合は Now の代わりに DateAdd("m",1,Now) を使用します。
    ' 月単位ではなく任意の単位にする場合は以下の記述を変更します。
    strStart = Year(Now) & "/" & Month(Now) & "/1 00:00"
    strEnd = DateAdd("m", 1, CDate(strStart)) & " 00:00"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set stmCSVFile = objFSO.CreateTextFile(CSV_FOLDER_NAME & strUserName & ".csv", True)
    ' CSV ファイルのヘッダです。出力するフィールドを増減する場合はこちらも変更してください。
    stmCSVFile.WriteLine """件名"",""場所"",""開始日"",""開始時刻"",""終了日"",""終了時刻"",""分類項目"",""主催者"",""必須出席者"",""任意出席者"""
    Set colAppts = fldCalendar.Items
    colAppts.Sort "[Start]"
    colAppts.IncludeRecurrences = True
    Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
    While Not objAppt Is Nothing
        strLine = """" & objAppt.Subject & _
            """,""" & objAppt.Location & _
            """,""" & FormatDateTime(objAppt.Start, vbShortDate) & _
            """,""" & FormatDateTime(objAppt.Start, vbShortTime) & _
            """,""" & FormatDateTime(objAppt.End, vbShortDate) & _
            """,""" & FormatDateTime(objAppt.End, vbShortTime) & _
            """,""" & objAppt.Categories & _
            """,""" & objAppt.Organizer & _
            """,""" & objAppt.RequiredAttendees & _
            """,""" & objAppt.OptionalAttendees & _
            """"
'
       stmCSVFile.WriteLine strLine
        Set objAppt = colAppts.FindNext
    Wend
    stmCSVFile.Close
End Sub

マクロの登録方法やメニューへの追加について

広告

ナビゲーションウィンドウの予定表でチェックがついている他人の予定表をエクスポートするマクロ」への4件のフィードバック

  1. この機能(予定表のナビゲーション モジュールの取得)はOutlook2007移行の機能のようですが、Outlook2003 でも同じようなことは実現不可能でしょうか?

  2. Set fldCalendar = Session.GetSharedDefaultFolder(objRecip, olFolderCalendar)
    の部分でエラーにもならず、ExportOneUserから抜けてしまいます。
    Outlook2010です。

  3. マクロありがとうございます。
    実際に使用してみて疑問点が2点あるので、お手数ですが回答をお願います。

    1.上記マクロを実行したところ、共有フォルダに新たに予定表ー名前の予定が出来上がっている。
      もともと部署ごとに予定表を共有しているので、新たに出来て欲しくない。

    2.予定表の共有を行っているのに、CSVファイルが作成されないメンバーが3名います、
      考えられる原因はありますか?

    以上 よろしくお願いします。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中