三流君 Outlook Appointment 予定表を操作する

'VBSからOutlook 予定表のアイテム作成をテスト
'入力された名前で予定のアイテムを1つ作成する

Dim yoteiNAME  '予定の名前

yoteiNAME = InputBox("予定の題名・件名は？") '入力させる


'Outlookの起動 アプリケーション を 作成する

    Dim oApp        'As Outlook.Application OutlookのApplication オブジェクトを入れる
    Dim myNameSpace 'As Outlook.NameSpace 名前のスペースと言われても、、
    Dim myFolder    'As Outlook.Folder フォルダー指定

    'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を
    Set oApp = CreateObject("Outlook.Application")

    '呪文１ 名前空間 の 指定 と言っても、.GetNamespace("MAPI")しただけ
    Set myNameSpace = oApp.GetNamespace("MAPI")

'olFolderCalendar 9 予定フォルダ ※カレンダー
    '次は作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display)
    Set myFolder = myNameSpace.GetDefaultFolder(9) '規定のフォルダー olFolderCalendar=9 指定
    myFolder.Display  '表示 いつものクセで .Visible = True とやりがちだけど

    '通常サイズ olNormalWindow=2 で表示(ほかに olMaximized=0,olMinimized=1)
    oApp.ActiveWindow.WindowState = 2   'olNormalWindow=2 を セット

'ここから予定の作成
'CreateItem(1) とolAppointmentItem=1 1を指定しただけ。

    Dim aITEM   'As Outlook.AppointmentItem '予定、アポ
    
    'CreateItemで予定の作成
    Set aITEM = oApp.CreateItem(1)   'olAppointmentItem=1 1予定・アポを指定
    
    aITEM.Display   '編集画面表示
    
    'データのセット
    aITEM.Subject = yoteiNAME & "の件"
    aITEM.Body = "予定の本文" & vbCrLf & "２行目" & vbCrLf & "xxxxx"
    aITEM.Start = Now()   'テストで現在の時刻をセット
    aITEM.End = DateAdd("h", 1, Now())  '1時間後を計算、終了にセット
 
    '動作
    'aITEM.Save   '.Saveで保存 .Close時に下記みたいに閉じると同時に保存も可能
    aITEM.Close 0 '保存して閉じる olSave=0  olDiscard=1 olPromptForSave=2    '