追記：2019/09/06
こちらの記事は以前に紹介したコードです。
エラーが起こりにくくより機能を追加した新しいサンプルコードはこちらの記事を参考にしてください。
意外と面倒なOutlook予定表入力
最近自身の予定はGoogleアカウントで管理していたので、マクロを使う機会は少なかったのですが、先日部署内の予定をすべてOutlookで管理することになりました。
全部転記するのが面倒でVBAコードを作成したのでこちらでご紹介します。
スポンサーリンク
Excelのシートに予定一覧を作成する
今回のVBAコードは「元々Excelで管理している予定表シートをOutlook予定表に入力するもの」を想定しています。
Excelのシートの情報がないとVBAコードを紹介しても意味がないので先にExcelのシートについてご紹介します。
Excelでの予定表シートは以下のような形式です。
項目の数（行数）はいくつでも全部順に読み込む仕様になります。
Outlook予定表入力VBAコード
作成したVBAコードは以下のようになります。
項目の順序は入れ替えてもコードの変更が最小限になるように、最初に「タイトル」「場所」「開始日」「開始時間」などの変数に代入するようにしています。
また日付と時間は運用しやすいようにセルの書式設定を整えた上、文字列型で代入するようにしています。
（日付型で宣言すると一つのセルで日付と時間を管理しないとうまく動作しなかったです。）
Sub シートからアウトルック予定表入力()
Dim i As Long
Dim oApp’As Outlook.Application 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) ’規定のフォルダー olFolderCalendar=9 指定
myFolder.Display
oApp.ActiveWindow.WindowState = 2 ’olNormalWindow=2 (olMaximized=0,olMinimized=1)
Dim aITEM’As Outlook.AppointmentItem
Dim タイトル As String, 場所 As String, 内容 As String
Dim 開始日 As String, 開始時間 As String, 終了日 As String, 終了時間 As String
i = 2
Do Until Cells(i, 1).Value = “”
タイトル = Cells(i, 1)
場所 = Cells(i, 2)
内容 = Cells(i, 3)
開始日 = Cells(i, 4).Text
開始時間 = Cells(i, 5).Text
終了日 = Cells(i, 6).Text
終了時間 = Cells(i, 7).Text
Set aITEM = oApp.CreateItem(1)’olAppointmentItem=1 1予定・アポを指定
aITEM.Display’編集画面表示
aITEM.Subject = タイトル
aITEM.Body = 場所
aITEM.Location = 内容
aITEM.Start = 開始日 & ” ” & 開始時間
If 終了日 = “” And 開始日 <> “” Then
終了日 = 開始日
End If
aITEM.End = 終了日 & ” ” & 終了時間
aITEM.Save
aITEM.Close 0
i = i + 1
Loop
’oApp.Quit
Set myFolder = Nothing
Set myNameSpace = Nothing
Set oApp = Nothing
End Sub
Dim i As Long
Dim oApp’As Outlook.Application 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) ’規定のフォルダー olFolderCalendar=9 指定
myFolder.Display
oApp.ActiveWindow.WindowState = 2 ’olNormalWindow=2 (olMaximized=0,olMinimized=1)
Dim aITEM’As Outlook.AppointmentItem
Dim タイトル As String, 場所 As String, 内容 As String
Dim 開始日 As String, 開始時間 As String, 終了日 As String, 終了時間 As String
i = 2
Do Until Cells(i, 1).Value = “”
タイトル = Cells(i, 1)
場所 = Cells(i, 2)
内容 = Cells(i, 3)
開始日 = Cells(i, 4).Text
開始時間 = Cells(i, 5).Text
終了日 = Cells(i, 6).Text
終了時間 = Cells(i, 7).Text
Set aITEM = oApp.CreateItem(1)’olAppointmentItem=1 1予定・アポを指定
aITEM.Display’編集画面表示
aITEM.Subject = タイトル
aITEM.Body = 場所
aITEM.Location = 内容
aITEM.Start = 開始日 & ” ” & 開始時間
If 終了日 = “” And 開始日 <> “” Then
終了日 = 開始日
End If
aITEM.End = 終了日 & ” ” & 終了時間
aITEM.Save
aITEM.Close 0
i = i + 1
Loop
’oApp.Quit
Set myFolder = Nothing
Set myNameSpace = Nothing
Set oApp = Nothing
End Sub
Googleやその他のアプリなど色々と出てきていますが、セキュリティの面やこれまでの慣習などでOutlookの予定表を使っている会社は多いと思います。
今回紹介したVBAが少しでも役立つと嬉しいです。
コメント