Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

69879 / 76732

←次へ　｜　前へ→


	【11368】Re:Outlook予定表とエクセル

H. C. Shinopy - 04/3/6(土) 23:07 -


	引用なし

	パスワード

御質問されてから随分と日が経っていますので、
取り敢えず、回答まで。

下の例では、
Outlookの予定表から開始時刻が2004年1月中のものを取り出しています。
私の環境（WindowsXP・Outlook2002）で実行すると、
なぜか入力した順に予定表アイテムが取り出されるので、
取り出し後に、開始時刻で並び替えをしています。

Sub myOutlookCalendar()
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Rem 参照設定：Microsoft Outlook 10.0 Object Library
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Dim myOutlook As New Outlook.Application
　Dim myNameSpace As Outlook.NameSpace
　Dim myCalendar As Outlook.MAPIFolder
　Dim myAppt As Outlook.AppointmentItem
　Dim i As Integer
　Dim myAddr As String
　'
　Set myNameSpace = myOutlook.GetNamespace("MAPI")
　Set myCalendar = myNameSpace.GetDefaultFolder(olFolderCalendar)
　'
　Rem 見出し行
　ActiveSheet.Range("A1").Select
　i = 1
　With ActiveSheet
　　.Cells(i, 1).Value = "件名"
　　.Cells(i, 2).Value = "場所"
　　.Cells(i, 3).Value = "開始時刻"
　　.Cells(i, 4).Value = "終了時刻"
　　.Cells(i, 5).Value = "本文"
　End With
　'
　Rem 予定表アイテム
　i = 2
　For Each myAppt In myCalendar.Items
　　Rem 2004年1月分
　　If myAppt.Start >= #1/1/2004# And myAppt.Start < #2/1/2004# Then
　　　With ActiveSheet
　　　　.Cells(i, 1).Value = myAppt.Subject
　　　　.Cells(i, 2).Value = myAppt.Location
　　　　.Cells(i, 3).Value = myAppt.Start
　　　　.Cells(i, 4).Value = myAppt.End
　　　　.Cells(i, 5).Value = myAppt.body
　　　End With
　　　i = i + 1
　　End If
　Next myAppt
　'
　Rem 開始時刻で並び替え
　ActiveSheet.UsedRange.Select
　myAddr = ActiveWindow.Selection.Address(False, False)
　Range(myAddr).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess
　ActiveSheet.Range("A1").Select
　'
　Set myNameSpace = Nothing
　Set myCalendar = Nothing
End Sub

0 hits

▼

【11200】Outlook予定表とエクセル liee_chang 04/3/2(火) 14:30