Outlook予定表作成をExcelのVBAで行う
リクエスト頂きましたので書いていきます。
だいぶ前に作ったものなので、詳細などは忘れている部分もあり、
また、訳もわからずに使っているコードもあります^^;
なので細かい質問などに答えられる自信は無いことを宣言しておきます（滝汗）。
申し訳ないことにコードは一部丸々コピーしているものも有ります。出典は以下です。
三流君VBAでOutlookを操作する
Outlook 研究所 | Outlook を徹底活用する方法を研究するサイトです。
予定表作成のブックは2つのシートがあります。
①Sheet1に実際の予定を作成する表とコントロールを配置しています。
VBAコードもSheet1に書いてます。
②Sheet2に表に入力規則から入力する既定の各リストを羅列しています。
ただリストを使わなきゃ要りませんし、Sheet1の端っこに記入してもいいです。
Sheet1の記入
各コントロールを適当に配置します。
MonthView Control 日付の入力に使います
CommandButton1(入力のクリア) クリアに使います
CommandButton2(保存しないで閉じる) ブックを閉じます
CommandButton3(予定作成！) 予定表作成を実行します
表は図のように作成します。
L列には「=IF(K14="◯",TRUE,FALSE)」
O列には「=IF(N14="◯",TRUE,FALSE)」と関数を入れた後、目障りなので非表示にしときます。
なおKとL列には入力規則で”○”をリストにしておきます。
一応、一度に10件までは予定を立案できるようにしてあります。
分類項目等をドロップダウンリストから選択するようにするならば、該当セルに設定しておいてください。
分類項目を使いたい場合は、先にOutlookの分類項目を作成しておかなくてはイケマセンよ～
MonthView Controlを配置（無くてもいいです）
MonthViewのコード（カレンダークリックで日付入力）
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Dim Ni As Long
Ni = Range("B" & Rows.Count).End(xlUp).Row
Range("B" & Ni + 1).Value = MonthView1.Value
End Sub
CommandButton1のコード
10件を超えて連続して予定を入れていきたい際には一発クリアで便利。
項目が増えることも考えて、余計な書き方になっています。
Private Sub CommandButton1_Click()
Dim R1 As Range
Set R1 = Range("B14:K23,M14:M23,N14:N23,P14:P23")
R1.Value = ClearContents
End Sub
CommandButton2のコード
保存せずに閉じるだけのコード
Private Sub CommandButton2_Click()
Application.DisplayAlerts = False
ThisWorkbook.Close
End Sub
CommandButton3のコード
いよいよOutlook予定表を作成します。
'//
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub CommandButton3_Click()
'outlook用宣言
Dim oApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim objITEM As Object
Dim objWShell As Object
Dim flg As Boolean
Dim hwnd As Long
Dim i As Integer
Dim jDAte As Date
Dim jTime As String
Dim jCate As String
Dim jLon As Integer
Dim jSub As String
Dim jBdy As String
Dim jRem As Boolean
Dim jRet As Integer
Dim jAll As Boolean
Dim jBusy As Integer
'クラス名
Const FCLASSNAME As String = "rctrl_renwnd32"
'Outlook 起動
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application") '既に起動している場合に取得
If Err.Number <> 0 Then
Set oApp = CreateObject("Outlook.Application")
flg = True
End If
On Error GoTo 0
'予定表各項目
For i = 14 To 23 '予定表内容のセル番号を指定
jDAte = Range("B" & i) '予定日
jTime = Range("C" & i) '予定時刻
jCate = Range("E" & i) '分類項目
jLon = Range("D" & i) '時間
jSub = Range("F" & i) '件名
jBdy = Range("G" & i) '本文
jRem = Range("L" & i) 'リマインダー
jRet = Range("M" & i) '通知時間
jAll = Range("O" & i) '終日指定
jBusy = Range("P" & i) '公開方法
If Range("B" & i) = "" Then Exit For '空白だったらループ脱出
If flg Then
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(9) '起動時フォルダーを指定
myFolder.Display
Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
objITEM.Display '編集画面を表示
Else
Set objWShell = CreateObject("WScript.Shell")
objWShell.AppActivate oApp.ActiveWindow.Caption 'アクティブ化
hwnd = FindWindow(FCLASSNAME, vbNullString)
SetForegroundWindow hwnd '前面に持ってきて
objWShell.SendKeys "%R" '元に戻す
Set objWShell = Nothing 'ここで終わった後に、
Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
objITEM.Display '編集画面を表示
End If
'予定表内容詳細
objITEM.Subject = jSub '件名をセット
objITEM.body = jBdy '本文をセット
objITEM.Duration = jLon '時間（分単位）でセット
objITEM.Start = DateValue(Format(jDAte)) & " " & jTime '予定日と開始時刻をセット 時刻のスペースはOutlookで必須のよう
objITEM.AllDayEvent = jAll '終日指定するか？
objITEM.ReminderSet = jRem 'リマインダーセット（←はfalseの場合しない）
objITEM.ReminderMinutesBeforeStart = jRet 'リマインダー（開始何分前にアラームを出すか？）
objITEM.Categories = jCate '分類項目をセット
objITEM.BusyStatus = jBusy '公開方法をセット0～4
objITEM.Save '保存して
objITEM.Close 2 '閉じる
Next i '次のセルの日付へ
Set oApp = Nothing 'ループ脱出してもOutlookは何もしない
End Sub
予定表に追加したい項目があるのならば、ここを参照して追加してください。
なお、公開方法の内容は下記。
0空き時間
1仮の予定
2取り込み中
3外出中
4他の場所での作業
Outlook予定表作成の流れ
1.予定日のカレンダー日付をクリックする
2.開始時刻入力（ex.8時30分→8：30）
3.時間を入力。「分」単位で入力する
4.分類項目(DDリストから）選択または無指定
5.件名を(DDリストから）選択または自由入力
6.本文を(DDリストから）選択または自由入力
7.通知設定の有無をDDリストから選ぶ ○で有り
8.通知時間セット 分単位で
9.終日指定をDDリストからセット ○で有り
10.公開方法0～4 セット空欄は空き時間
11.「予定作成！」ボタンをクリック→Outlook起動、予定立案
12.「入力のクリア」をクリックして、続いて予定表作成するか
「保存しないで閉じる」をクリックして終了
あれ～分かりやすい説明に成った？上手く出来なかったかもしれません(TдT)
わからなかったらコメントしてください。すみません・・・書き方下手になったなぁ～
Office2007で作成して、10でも13でも使えてますので問題は無いかと思います・・・・
