【Outlook】参照権のある他人の予定表を抽出する

Outlookで参照権のある予定表を抽出する方法のご紹介です。

Outlook予定表への参照権限

前に、フォルダ参照権しかないOutlook予定表を抽出する方法を書きました

予定表を抽出することはできるのですけどこれだと会議の主催者も使うリソース(会議室・設備)の情報も抜くことができません。「設備の使用実績集計してみて」って軽く言われたんですけどこれだとできないので、もうちょっと工夫が必要です。

結論を言うと予定表の読み取りに「全詳細情報」の権限があれば設備の利用実績をとることができます。
「全詳細情報」というと予定表のすべてを読み取れそうでどきっとしますが、個々の予定の詳細情報が読み取れるだけで非公開の予定は読み取れません。ちょっと趣旨がちがうのですが下記のページがよくまとまっていてわかりやすのでリンクを貼っておきます。
予定表アクセス権まとめ

全詳細情報の参照権のある予定表をEWSで抽出する

Exchange Web Service(EWS)を使えば参照権のある予定表を抽出することができます。EWSをつかうにはManaged APIを使うと楽です。Managed APIはMicrosoftがC#やVB.NetからAPI呼び出しでEWSを使うために作成したAPIですが今ではオープンソースとしてGit-Hubで開発されています。

OfficeDev/ews-managed-api

ダウンロードするには、Nugetを使えばできます

NuGet:Microsoft.Exchange.WebServices

これを使ってデータをダウンロードできるようにしたサンプルソース。

param(
$ExchangeUser = "User01@xxxx.onmicorosoft.com" ,# User information for Office365
$ExchangePassword = "xxxxxxxxx",
$ProxyUser = """user@xxx.yourdomain.com""", # User information for Proxy authentication
$ProxyPassword = "9999999999999",
$CSV = "$PSScriptroot\Calender_by_powershell.csv",
$Mailboxes =  @("User01@xxx.onmicrosft.com", "User02@xxx.onmicrosft.com", "User03@xxx.onmicrosft.com"),
$ExchangeDomain = "@xxxx.onmicorosoft.com"
)

#Credentials Using Script Argument
if([String]::IsNullOrWhiteSpace($ExchangeUser))
{
$PSCredential = Get-Credential -Message "Input ExchangeOnline User/Password" -UserName ($env:USERNAME + $ExchangeDomain)
$ExchangeCredential = New-Object System.Net.NetworkCredential($PSCredential.UserName.ToString(),$PSCredential.GetNetworkCredential().password.ToString())  
}else{
$ExchangeCredential = New-Object System.Net.NetworkCredential($ExchangeUser,$ExchangePassword)  
}
#If you don't need Proxy authentication,comment out below
if([String]::IsNullOrWhiteSpace($ProxyUser)){
$ProxyCredntial = Get-Credential -Message "input Proxy User/Password" -UserName ($env:USERNAME + $ExchangeDomain)
}else{
$SecureProxyPassword = ConvertTo-SecureString $ProxyPassword -AsPlainText -Force
$ProxyCredntial = New-Object System.Management.Automation.PSCredential $ProxyUser, $SecureProxyPassword
}
$SystemProxy = [System.Net.WebRequest]::GetSystemWebProxy() #Get WebProxy information
$SystemProxy.Credentials = $ProxyCredntial

#Set Extract Period
$Date= (get-date).AddMonths(-1)
$StartDate = Get-Date ($Date.tostring("yyyy/MM/") +"21")
$EndDate   =$StartDate.AddMonths(1)

$DLLPath ="C:\Program Files\PackageManagement\NuGet\Packages\exchange.webservices.managed.api.2.2.1.2\lib\net35\Microsoft.Exchange.WebServices.dll"
#save dll to same folder as script
if(Test-Path $DLLPath){Import-Module $DLLPath}else{
$ModulePath = ($env:PSModulePath).Substring(0,($env:PSModulePath).IndexOf(";")) #get first path of $env:PSModulePath. Normally,it's User's document folder
if (-not (Test-Path $ModulePath)){NI $ModulePath -ItemType Directory}           #PowerShell Module path of User's document folder don't exist in default
Copy-Item  ($PSScriptRoot + "\Microsoft.Exchange.WebServices.*")  $ModulePath
Import-Module "$ModulePath\Microsoft.Exchange.WebServices.dll"
}
$service = New-Object Microsoft.Exchange.WebServices.Data.ExchangeService
$service.Credentials = $ExchangeCredential
$service.WebProxy =$SystemProxy

# you need to use AutoDiscoverUrl method at Office365
$service.AutodiscoverUrl($ExchangeUser, {$true})

$RptCollection = @()
$Recurring = new-object Microsoft.Exchange.WebServices.Data.ExtendedPropertyDefinition([Microsoft.Exchange.WebServices.Data.DefaultExtendedPropertySet]::Appointment, 0x8223,[Microsoft.Exchange.WebServices.Data.MapiPropertyType]::Boolean); 
$psPropset= new-object Microsoft.Exchange.WebServices.Data.PropertySet([Microsoft.Exchange.WebServices.Data.BasePropertySet]::FirstClassProperties)  
$psPropset.Add($Recurring)
$psPropset.RequestedBodyType = [Microsoft.Exchange.WebServices.Data.BodyType]::Text;

$AppointmentState = @{0 = "None" ; 1 = "Meeting" ; 2 = "Received" ;4 = "Canceled" ; }

foreach($MailboxName in $Mailboxes){
# Bind to the Calendar Folder
$folderid= new-object Microsoft.Exchange.WebServices.Data.FolderId([Microsoft.Exchange.WebServices.Data.WellKnownFolderName]::Calendar,$MailboxName)   
$Calendar = [Microsoft.Exchange.WebServices.Data.Folder]::Bind($service,$folderid)
  
#Define the calendar view  
$CalendarView = New-Object Microsoft.Exchange.WebServices.Data.CalendarView($StartDate,$EndDate,1000)    
$fiItems = $service.FindAppointments($Calendar.Id,$CalendarView)
if($fiItems.Items.Count -gt 0){
 $type = ("System.Collections.Generic.List"+'`'+"1") -as "Type"
 $type = $type.MakeGenericType("Microsoft.Exchange.WebServices.Data.Item" -as "Type")
 $ItemColl = [Activator]::CreateInstance($type)
 foreach($Item in $fiItems.Items){$ItemColl.Add($Item)} 
 [Void]$service.LoadPropertiesForItems($ItemColl,$psPropset)
   
}#End of if($fiItems.Items.Count -gt 0)
foreach($Item in $fiItems.Items){      
 $rptObj = "" | Select User,StartTime,EndTime,Duration,Type,Subject,Location,Organizer,Attendees,Resources,AppointmentState,Notes,HasAttachments,IsReminderSet,ReminderDueBy
 $rptObj.User = $MailboxName
 $rptObj.StartTime = $Item.Start  
 $rptObj.EndTime = $Item.End  
 $rptObj.Duration = $Item.Duration
 $rptObj.Subject  = $Item.Subject   
 $rptObj.Type = $Item.AppointmentType
 $rptObj.Location = $Item.Location
 $rptObj.Organizer = $Item.Organizer.Address
 $rptObj.HasAttachments = $Item.HasAttachments
 $rptObj.IsReminderSet = $Item.IsReminderSet
 $rptObj.ReminderDueBy = $Item.ReminderDueBy
 $aptStat = "";
 $AppointmentState.Keys | where { $_ -band $Item.AppointmentState } | foreach { $aptStat += $AppointmentState.Get_Item($_) + " "}
 $rptObj.AppointmentState = $aptStat 
 $RptCollection += $rptObj
    foreach($attendee in $Item.RequiredAttendees){
  $atn = $attendee.Address + " Required "  
  if($attendee.ResponseType -ne $null){
   $atn += $attendee.ResponseType.ToString() + "; "
  }
  else{
   $atn += "; "
  }
  $rptObj.Attendees += $atn
 }
 foreach($attendee in $Item.OptionalAttendees){
  $atn = $attendee.Address + " Optional "  
  if($attendee.ResponseType -ne $null){
   $atn += $attendee.ResponseType.ToString() + "; "
  }
  else{
   $atn += "; "
  }
  $rptObj.Attendees += $atn
 }
 foreach($attendee in $Item.Resources){
  $atn = $attendee.Address + " Resource "  
  if($attendee.ResponseType -ne $null){
   $atn += $attendee.ResponseType.ToString() + "; "
  }
  else{
   $atn += "; "
  }
  $rptObj.Resources += $atn
 }
 $rptObj.Notes = $Item.Body.Text
 "User     :" + $MailboxName
 "Start    : " + $Item.Start  
 "Subject     : " + $Item.Subject 
 } #End of foreach($Item in $fiItems.Items)
}#end of foreach($MailboxName in $Mailboxes){ 

$RptCollection | Export-Csv -NoTypeInformation -Path $CSV -Encoding Default

全詳細情報の参照権のある予定表をExcel VBAで抽出する

VBではGetSharedDefaultFolder関数を使えば抽出できます。

Microsoft Officeデベロッパーセンター<:getshareddefaultfolder メソッド

Excel VBAをつかったソースは下記のようになります。

Public Sub ExportSharedCalendar()
    Dim Outlook 'As Application
    Dim ExportDate As Date
    Dim StartDate As Date
    Dim EndDate As Date
    Dim i, j As Integer
    
    'Outlookの内部設定値
    'https://docs.microsoft.com/ja-jp/dotnet/api/microsoft.office.interop.outlook.oldefaultfolders?view=outlook-pia
    Const olFolderCalendar = 9
    ExportDate = DateAdd("m", -1, Now)
    StartDate = DateSerial(Year(ExportDate), Month(ExportDate), 21) '前月の21日を作ります
    EndDate = DateAdd("m", 1, StartDate)
    'InputBoxを使って初期値を表示、入力された値で書き換え
    StartDate = Application.InputBox("開始日時を入力してください", "StartDate", Format(StartDate, "yyyy/MM/dd hh:nn:ss"))
    EndDate = Application.InputBox("終了日時を入力してください", "EndDate", Format(EndDate, "yyyy/MM/dd hh:nn:ss"))
    
    Dim AddressList
    AddressList = Array("user01@xxx.onmicrosoft.com", "user02@xxx.onmicrosoft.com", "user03@xxx.onmicrosoft.com", "user04@xxx.onmicrosoft.com")
    
    Dim MailAddress, UserName As String
    Dim TargetRecipient 'As Recipient
    Dim FolderItems 'As Items
    Dim Appointment 'As AppointmentItem
    Dim strLine As String
    'Outlookを設定する
    Set Outlook = CreateObject("Outlook.Application")

    Dim sFilter As String
    Dim RowCount As Long
    Dim ExtractSheet As Object
    Set ExtractSheet = ThisWorkbook.Sheets(1)
    ExtractSheet.Cells.Clear
    RowCount = 1
    With ExtractSheet
        .Activate
        .Cells(RowCount, 1).Value = "ユーザー名"
        .Cells(RowCount, 2).Value = "EntryID"
        .Cells(RowCount, 3).Value = "開始日"
        .Cells(RowCount, 4).Value = "開始時刻"
        .Cells(RowCount, 5).Value = "終了時刻"
        .Cells(RowCount, 6).Value = "件名"
        .Cells(RowCount, 7).Value = "予約者"
        .Cells(RowCount, 8).Value = "リソース"
        .Cells(RowCount, 9).Value = "作成日時"
        .Cells(RowCount, 10).Value = "修正日時"
        .Cells(RowCount, 11).Value = "必須出席者"
        .Cells(RowCount, 12).Value = "任意出席者"
        .Cells(RowCount, 13).Value = "分類項目"
        .Cells(RowCount, 14).Value = "場所"
        .Cells(RowCount, 15).Value = "内容"

For i = LBound(AddressList) To UBound(AddressList)
    
    MailAddress = AddressList(i)
    Set TargetRecipient = Outlook.Session.CreateRecipient(MailAddress)
    TargetRecipient.Resolve
    If Not TargetRecipient.Resolved Then
        MsgBox "ユーザーが特定できませんでした。" & MailAddress, vbCritical, "GetSharedDefaultFolder"
        GoTo NextUser
    Else
        UserName = TargetRecipient.Name
    End If
    Set FolderItems = Outlook.Session.GetSharedDefaultFolder(TargetRecipient, olFolderCalendar).Items
    FolderItems.Sort "[Start]"
    FolderItems.IncludeRecurrences = True
    'AppointmentItemのFindメソッドは文字型しか受け取らないので文字で作成します。
    'https://docs.microsoft.com/ja-jp/office/vba/api/outlook.items.find
    '終了日までに開始するもの & 開始日以降に終わるものでFilterを作ります。
    sFilter = "[Start] < """ & Format(EndDate, "yyyy/MM/dd") & """ AND [End] >= """ & Format(StartDate, "yyyy/MM/dd") & """"
    Set Appointment = FolderItems.Find(sFilter) '
    While Not Appointment Is Nothing
         RowCount = RowCount + 1
    
            .Cells(RowCount, 1).Value = UserName
            .Cells(RowCount, 2).Value = Appointment.EntryID
            .Cells(RowCount, 3).Value = FormatDateTime(Appointment.Start, vbShortDate)
            .Cells(RowCount, 4).Value = FormatDateTime(Appointment.Start, vbShortTime)
            .Cells(RowCount, 5).Value = FormatDateTime(Appointment.End, vbShortTime)
            .Cells(RowCount, 6).Value = Appointment.Subject
            .Cells(RowCount, 7).Value = Appointment.Organizer
            .Cells(RowCount, 8).Value = Appointment.Resources
            .Cells(RowCount, 9).Value = Appointment.CreationTime
            .Cells(RowCount, 10).Value = Appointment.LastModificationTime
            .Cells(RowCount, 11).Value = Appointment.RequiredAttendees
            .Cells(RowCount, 12).Value = Appointment.OptionalAttendees
            .Cells(RowCount, 13).Value = Appointment.Categories
            .Cells(RowCount, 14).Value = Appointment.Location
            .Cells(RowCount, 15).Value = Appointment.Body
         Set Appointment = FolderItems.FindNext
    Wend
NextUser:
    Set TargetRecipient = Nothing
    Set FolderItems = Nothing
    Set Appointment = Nothing
    
Next

    End With
    Set Outlook = Nothing

    MsgBox "終了しました"
End Sub

コメントを残す

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

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください