【Outlook】参照権のある他人の予定表を抽出する
Outlookで参照権のある予定表を抽出する方法のご紹介です。
Outlook予定表への参照権限
前に、フォルダ参照権しかないOutlook予定表を抽出する方法を書きました
予定表を抽出することはできるのですけどこれだと会議の主催者も使うリソース（会議室・設備）の情報も抜くことができません。「設備の使用実績集計してみて」って軽く言われたんですけどこれだとできないので、もうちょっと工夫が必要です。
結論を言うと予定表の読み取りに「全詳細情報」の権限があれば設備の利用実績をとることができます。
「全詳細情報」というと予定表のすべてを読み取れそうでどきっとしますが、個々の予定の詳細情報が読み取れるだけで非公開の予定は読み取れません。ちょっと趣旨がちがうのですが下記のページがよくまとまっていてわかりやすのでリンクを貼っておきます。
予定表アクセス権まとめ
全詳細情報の参照権のある予定表をEWSで抽出する
Exchange Web Service(EWS)を使えば参照権のある予定表を抽出することができます。EWSをつかうにはManaged APIを使うと楽です。Managed APIはMicrosoftがC#やVB.NetからAPI呼び出しでEWSを使うために作成したAPIですが今ではオープンソースとしてGit-Hubで開発されています。
ダウンロードするには、Nugetを使えばできます
NuGet:Microsoft.Exchange.WebServices
これを使ってデータをダウンロードできるようにしたサンプルソース。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
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をつかったソースは下記のようになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
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("ｍ", -1, Now) StartDate = DateSerial(Year(ExportDate), Month(ExportDate), 21) '前月の21日を作ります EndDate = DateAdd("ｍ", 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 |
“【Outlook】参照権のある他人の予定表を抽出する” に対して1件のコメントがあります。
コメントを残す
このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。
Dim i, j As long
i が variant型になります