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
4 hits

【11200】Outlook予定表とエクセル liee_chang 04/3/2(火) 14:30 質問
【11368】Re:Outlook予定表とエクセル H. C. Shinopy 04/3/6(土) 23:07 回答
【11387】Re:Outlook予定表とエクセル liee_chang 04/3/8(月) 12:56 質問
【11394】Re:Outlook予定表とエクセル こうちゃん 04/3/8(月) 15:06 発言
【11403】Re:Outlook予定表とエクセル liee_chang 04/3/8(月) 17:17 お礼

69879 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free