もくじ
The following two tabs change content below.
taka
あることがキッカケでVBAを独学で勉強しました、今ではブログを通してVBAでできることを解説しつつ、VBAや他の言語の勉強、ブログ運営の勉強をしています(^^♪
最新記事 by taka (全て見る)
- Excel関数【LENB関数】文字列のバイト数を求める - 2018年9月20日
- Excel関数【Mod関数】割り算の余りを取得する - 2018年9月19日
- Excel関数【LEN関数】文字数をカウントする - 2018年9月18日
- VBA YahooAPIを使って２つの場所の経路を取得してみた - 2018年9月17日
- VBA Mod演算子を使って特定の倍数であるかを調べる - 2018年9月16日
どうも、takaです(^^♪
今回は久しぶりに「ExcelとOutlookの連携」のパート４です！
今までご紹介してきたのは「メール」のお話でしたが、今回は「予定表」のお話です！
お恥ずかしい話、私は仕事でも予定表をしようしていません（笑）
予定表の元となるExcelの表を準備
では表を簡単に用意してしまいましょう！
今回用意した項目は7つです。
- 予定の件名
- 予定内容
- 場所
- 開始日
- 開始時間
- 終了日
- 終了時間
この項目をOutlookの予定表へ転記します(^^♪
【Excelの表から予定表へ自動入力】サンプルコード
ではサンプルコードをご紹介します。
コードの説明はコメント欄にて書いてありますの(^^)/
ちなみに動作後はこんな感じになっております。８月1日の予定です（画像下部）
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | Sub sample() Dim i As Long Dim oApp As Outlook.Application Dim myNameSpace As Outlook.Namespace Dim myFolder As Outlook.Folder Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(9) '規定のフォルダーの指定：9 は予定表・６は受信トレイなので今回は9を指定 myFolder.Display 'Outlookを表示 oApp.ActiveWindow.WindowState = 2 'ウィンドウサイズの指定 Dim task As Outlook.AppointmentItem '予定表 Dim title As String '予定表のタイトル Dim place As String '予定の場所 Dim Contents As String '予定の内容 Dim Start As String '予定の開始日 Dim Starttime As String '予定の開始時間 Dim ed As String '予定の終了日 Dim edtime As String '予定の終了時間 i = 2 Do Until Cells(i, 1).Value = "" '表が終わるまでループ 'Excelの表のデータを取得 title = Cells(i, 1) place = Cells(i, 2) Contents = Cells(i, 3) Start = Cells(i, 4).Text Starttime = Cells(i, 5).Text ed = Cells(i, 6).Text edtime = Cells(i, 7).Text '予定表の処理 Set task = oApp.CreateItem(1) 'olAppointmentItem=1 1は予定 task.Display '編集画面表示 'Subject＝予定の名前 'Body＝予定の内容 'Location＝予定の場所 'Start＝予定の開始の日時 'End＝予定終了の日時 task.Subject = title task.Body = place task.Location = Contents task.Start = Start & " " & Starttime If ed = "" And Start <> "" Then ed = Start End If task.End = ed & " " & edtime task.Close 0 i = i + 1 Loop '表の予定がなくなるまで繰り返し 'oApp.Quit 'Outlookを終了、使う場合はコメントアウト！ Set myFolder = Nothing 'プロシージャー終了時に開放されるのは知っているよ！でも一応（笑） Set myNameSpace = Nothing Set oApp = Nothing End Sub |
ファイルやコードの利用、WEBサイトの利用について
サンプルコードなどは当サイトの免責事項をよくお読みになってからお使いください。Twitterフォロー
Twitterもやってます(^^♪ Excelについてはあまり触れませんがブログの更新のお知らせはツイートしています(^^♪
Follow @takabou63
使用OS：
コメントを残す