[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『OUTLOOKグループスケジュールをエクセルに落としたい』（稲葉）
OUTLOOK2007でグループスケジュール若しくは、共有の予定表（重ねて表示）（下図）を ○日 ○週 ●月 ／【稲葉】＼ ／『田中』＼ ／《鈴木》＼ 日曜日____________________ 月曜日____________________ 火曜日___________________ 水曜日 木曜日 金曜日 土曜日 3月30日___________________ 3月31日___________________ 4月1日___________________ 4月2日 4月3日 4月4日 4月5日 【08:00 10:00 ○×商事】 【12:00 15:00 ＡＢ市場】 《12:00 15:00 ＡＢ市場》 【08:00 11:00 □×鉄鋼】 『10:00 15:00 ＣＤ出版』 『10:00 15:00 ＣＤ出版』 《10:00 15:00 △×食品》 《09:00 17:00 ＥＦ磁器》 《09:00 17:00 ＥＦ磁器》 4月6日____________________ 4月7日___________________ 4月8日___________________ 4月9日 4月10日 4月11日 4月12日 【省略】 『省略』 《省略》 4月12日___________________ 4月13日___________________ 4月14日___________________ 4月15日 4月16日 4月17日 4月18日 【省略】 『省略』 《省略》
エクセルか、アウトルックの予定表のビューで こういう表にしたい。 [A] [B]_______________________ [C]_______________________ [D]_______________________ [E] [F] [G] [H] [1] 曜日 日曜日____________________ 月曜日____________________ 火曜日___________________ 水曜日 木曜日 金曜日 土曜日 [2] 氏名 3月30日___________________ 3月31日___________________ 4月1日___________________ 4月2日 4月3日 4月4日 4月5日 [3] 稲葉 【08:00 10:00 ○×商事】 【12:00 15:00 ＡＢ市場】 [4] ____ 【08:00 11:00 □×鉄鋼】 [5] 田中 ________________________ 『10:00 15:00 ＣＤ出版』 『10:00 15:00 ＣＤ出版』 [6] 鈴木 《10:00 15:00 △×食品》 《09:00 17:00 ＥＦ磁器》 《09:00 17:00 ＥＦ磁器》
ビューで不可能なら、 「稲葉 08:00 10:00 ○×商事」 「鈴木 10:00 15:00 △×食品」のように、開始と終了時間が 載っている予定アイテムのテキストをエクセルに出力したい。
＜ 使用 Excel：Excel2007、使用 OS：WindowsXP ＞
半分やりたいことが出来たので、載せておきます。 予定表のプロパティで、アクセス権の「既定」または接続するユーザーへ「全詳細情報」の参照権限 がないと取得できませんでしたが、同じ部署内程度でしたら十分運用出来そうでした。
本当は予定表に保存したグループスケジュールから名前をひっぱりたかったのですが 探しきれませんでした。 予定表に保存したグループスケジュールから名前を取得する方法及び、パプリック フォルダの予定表からデータを取り込む場合どのようにすればよいか、分かる方い たら教えてください。 エクセル以外の質問ですみません・・・ 参考にしたサイトはコード内に記述してあります。
'==ここから Option Explicit Public Result Public ItemCount Public Sub スケジュール表を一覧表に() 'http://outlooklab.wordpress.com/2008/08/16/%E3%81%BB%E3%81%8B%E3%81%AE%E3%83%A6%E3%83%BC%E3%82%B6%E3%83%BC%E3%81%AE%E4%BA%88%E5%AE%9A%E3%82%92%E4%B8%80%E6%8B%AC%E3%81%A7%E8%A1%A8%E7%A4%BA%E3%81%99%E3%82%8B%E3%83%9E%E3%82%AF%E3%83%AD/ 'http://outlooklab.wordpress.com/2008/02/23/exchange-%E7%92%B0%E5%A2%83%E3%81%A7%E5%85%B1%E6%9C%89%E3%81%95%E3%82%8C%E3%81%A6%E3%81%84%E3%82%8B%E4%BB%96%E4%BA%BA%E3%81%AE%E4%BA%88%E5%AE%9A%E8%A1%A8%E3%81%AE%E3%83%87%E3%83%BC%E3%82%BF%E3%82%92/ Dim GetStart As String Dim GetEnd As String Dim GetUser Dim GetDay As String Dim USER_ROW As Long ' '_/_/_/_/取得したいメンバーのエイリアス値を入れる_/_/_/_/ 'メモ欄 ( 稲葉 田中 鈴木 ) GetUser = Array("1234567", "1234568", "1234569") USER_ROW = 5 GetDay = InputBox("当月の予定=0 翌月の予定=1 を入力してください") If GetDay = "" Then MsgBox "正しく取得できませんでした。": Exit Sub GetStart = Year(Now) & "/" & Month(Now) + GetDay & "/1 00:00" GetEnd = DateAdd("m", 1, CDate(GetStart)) & " 00:00" Dim xl As Object Set xl = CreateObject("Excel.Application") ' '_/_/_/_/一人USER_ROW分の項目入力できるようにし、1行目に日付を入れる_/_/_/_/ Dim i As Long, n As Long ReDim Result(1 To (UBound(GetUser) + 1) * USER_ROW, 1 To 33) n = 2 For i = CDate(Format(GetStart, "mm/dd")) To CDate(Format(GetEnd, "mm/dd")) Result(1, n) = CDate(i) n = n + 1 Next i ' '_/_/_/_/予定表アイテムを取得する変数宣言_/_/_/_/ Dim objRecip As Recipient 'ユーザーを特定するときに使用する。 Dim objApoItem '予定表のアイテムを一つずつ取り出す（As AppointmentItem) Dim U As Long ' U = 2 ' '_/_/_/_/指定したユーザーで繰り返し処理_/_/_/_/ '処理の考え方 'Resultの2列目から○月1日の日付を順次入れると仮定し、「日」を引数に配列に加える。 '日付によって異なる項目数は、ItemCountにユーザーの開始行「U」を使って32の要素をもつ、静的配列を作り、同じく日を引数に加算する Dim j As Long Dim msg As String For i = 0 To UBound(GetUser) ' '#アドレス帳からユーザー名を探し、なければFalseを返す Set objRecip = Session.CreateRecipient(GetUser(i)) objRecip.Resolve If objRecip.Resolved Then ItemCount = Split(Evaluate("REPT(""" & U & ",""" & ",34)"), ",") ' '#予定表アイテムのコレクションをWithブロックで指定する。 With Application.Session.GetSharedDefaultFolder(objRecip, olFolderCalendar).Items On Error Resume Next .Sort "[Start]" .IncludeRecurrences = True If Not err <> 0 Then On Error GoTo 0 ' '#開始日から終了日までのアイテムをFindメソッドで探す Set objApoItem = .Find("[Start] < """ & GetEnd & """ AND [End] >= """ & GetStart & """") Result(U + 0, 1) = objRecip.Name ' '#While-Wendでアイテムが見つからなくなるまで繰り返す While Not objApoItem Is Nothing With objApoItem If Not .Location = "日本" Then Call GetData(.Start, .End, .Subject) ' '#開始日から終了日までが2日以上あれば、終了日まで件名を取得する If .End >= DateAdd("d", 1, CDate(.Start)) Then For j = DateAdd("d", 1, CDate(.Start)) To xl.WorksheetFunction.Min(.End, .Start + USER_ROW - 1) Step 1 Call GetData(j, .End, .Subject) Next j End If End If End With ' '#次のアイテムを探す Set objApoItem = .FindNext Wend Else msg = msg & objRecip.Name & "さんの情報が取得できませんでした" & vbNewLine End If err.Clear On Error GoTo 0 End With End If U = U + USER_ROW Next i If msg <> "" Then MsgBox msg ' '_/_/_/_/エクセルオブジェクトから新しいブックを作成して、結果を落とし込む_/_/_/_/ With xl .Visible = True: .UserControl = True .Workbooks.Add .ActiveWindow.DisplayGridlines = False With .ActiveWorkbook.Sheets(1) ' '#データを落とし込み、体裁を整える .Range("A1").Resize(UBound(Result, 1), UBound(Result, 2)).Value = Result .Range("A1").Value = Format(Now, "yy.mm.dd作成") ' '#セル全体 With .Cells With .Font .Name = "ＭＳ ゴシック" .Size = 9 End With .ShrinkToFit = True .ColumnWidth = 22 End With ' '#1行目 With .Range("1:1") .NumberFormatLocal = "m/d(aaa)" .HorizontalAlignment = xlCenter End With ' '#ユーザー毎の設定 For i = 2 To .UsedRange.Rows.Count Step USER_ROW With .Cells(i, 1).Resize(USER_ROW) .Merge .HorizontalAlignment = xlLeft End With With .Cells(i, 1).Resize(USER_ROW, .UsedRange.Columns.Count) .Borders.LineStyle = xlContinuous .Borders(xlInsideVertical).Weight = xlHairline .Borders(xlInsideHorizontal).Weight = xlHairline End With Next i ' '#土日に色を付ける Dim r As Range For i = 2 To .UsedRange.Columns.Count Select Case Format(.Cells(1, i).Value, "aaa") Case "土", "日" If r Is Nothing Then Set r = .Cells(1, i).Resize(.UsedRange.Rows.Count) Else Set r = xl.Union(r, .Cells(1, i).Resize(.UsedRange.Rows.Count)) End If End Select Next i r.Interior.Color = RGB(191, 223, 255) End With End With End Sub Private Sub GetData(ByVal datStart As Date, ByVal datend As Date, sbj As String) '_/_/_/_/エクセルに落とし込みたいデータを指定します。 Result(ItemCount(CInt(Format(datStart, "d"))), CInt(Format(datStart, "d")) + 1) = _ sbj & " " & Format(datStart, "hh:mm") & "〜" '↑ここの部分 ItemCount(CInt(Format(datStart, "d"))) = ItemCount(CInt(Format(datStart, "d"))) + 1 End Sub （稲葉） 2014/04/08(火) 15:45
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.