| |
御質問されてから随分と日が経っていますので、
取り敢えず、回答まで。
下の例では、
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
|
|
- 04/3/8(月) 15:06 -
