①Excelブック(VBA) → 予定表へスケジュールを登録して → Outlook
②Excelブック ← スケジュールを登録したよ ← Outlook
まとめてスケジュールをOutlook予定表へ登録したいときに便利ですね！
早速実装をして動かしてみましょう！
Excel VBAからOutlookを操作するための下準備
①まずExcelを起動し、「開発」タブをクリックします。
②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。
③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。
以上です。
VBAを実装する
続いてVBAを実装します。
今回VBAは以下の通りとなります。
Sub Outlookの予定表へ登録する()
'Outlook用の定義
Dim olApp As Outlook.Application
Dim olItem As AppointmentItem
'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
Dim i As Long
'スクリーンの更新は行われません。
Application.ScreenUpdating = False
'Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
'予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
With olItem
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
.End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
End With
'ここで保存
olItem.Save
Next
Else
MsgBox "処理を中断します"
Exit Sub
End If
'Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
'Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox "Outlook予定表の登録が完了しました！", vbInformation
End Sub
Sub Outlookの予定表へ登録する_重複スキップ版()
'Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim olItemBefor As AppointmentItem
Dim checkFlg As Long
'重複チェックフラグ初期値設定
checkFlg = 0
'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
Dim i As Long
'スクリーンの更新は行われません。
Application.ScreenUpdating = False
'Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
'予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
With olItem
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
.End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
'重複チェック
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = "AppointmentItem" Then
'登録されている予定表の件名と開始日時が一致していたらフラグを1にする
If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
checkFlg = 1
End If
End If
Next
If checkFlg <> 1 Then
'ここで保存
olItem.Save
End If
End With
'重複フラグリセット
checkFlg = 0
Next
Else
MsgBox "処理を中断します"
Exit Sub
End If
'Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
'Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox "Outlook予定表の登録が完了しました！", vbInformation
End Sub
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
こちらのif文の条件を緩和してください。
なお、if文を外すと問答無用にExcelリスト分の予定アイテムが更新されますのでご注意ください。
VBAは以下の通りとなります。
Sub Outlookの予定表へ登録する_重複スキップ_Excelリストから変更できる版()
'Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim olItemBefor As AppointmentItem
Dim checkFlg As Long
'重複チェックフラグ初期値設定
checkFlg = 0
'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
Dim i As Long
'スクリーンの更新は行われません。
Application.ScreenUpdating = False
'Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
'予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
'重複チェック＆更新処理
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = "AppointmentItem" Then
'ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新
If olItemBefor.EntryID = Cells(i, 9) Then
'比較用に一時的に作成
With olItem
.Subject = Cells(i, 1)
.Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
.End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
End With
'重複フラグ1をセット
checkFlg = 1
'登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
'※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
Else
With olItemBefor
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
.End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
.Save
End With
End If
'Null out the variables.
Set olItem = Nothing
End If
End If
Next
If checkFlg <> 1 Then
'ExcelI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録
With olItem
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
.End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
.Save
End With
'ExcelI列へ発行されたEntryIDを書き込み
Cells(i, 9) = olItem.EntryID
End If
'重複フラグリセット
checkFlg = 0
Next
Else
MsgBox "処理を中断します"
Exit Sub
End If
'Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
'Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox "Outlook予定表の登録が完了しました！", vbInformation
End Sub
こちらの登録機能に追加で、
Excelのシート2に作成した表をOutlook本文下に画像として挿入
or
Excelに貼った画像を範囲指定しOutlook本文下に画像として挿入したいのですが、この場合どうすればよろしいでしょうか。
自分でも調べてみたのですが、初心者のため他の方の作成されたコードとの兼ね合いが分からず問い合わせさせていただきました。
なお出席者や本文単体の更新はできませんが、変更したい場合は以下のif文の条件を緩和してみてください。
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
Sub Outlookの予定表へ登録する_重複スキップ_エクセルリストから変更できる版()
‘Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim checkFlg As Long
‘重複チェックフラグ初期値設定
checkFlg = 0
‘Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
‘Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
Dim rc As Integer
rc = MsgBox(“予定表へ登録しますか？”, vbYesNo + vbQuestion, “確認”)
If rc = vbYes Then
‘予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
‘重複チェック＆更新処理
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = “AppointmentItem” Then
‘エクセルI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新
If olItemBefor.EntryID = Cells(i, 9) Then
‘比較用に一時的に作成
With olItem
.Subject = Cells(i, 1)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
End With
‘重複フラグ1をセット
checkFlg = 1
‘登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
‘※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
Else
With olItemBefor
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
.Save
End With
End If
‘Null out the variables.
Set olItem = Nothing
End If
End If
Next
If checkFlg 1 Then
‘エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録
With olItem
‘Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim checkFlg As Long
‘重複チェックフラグ初期値設定
checkFlg = 0
‘Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
‘Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
‘重複チェック
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = “AppointmentItem” Then
‘登録されている予定表の件名と開始日時が一致していたらフラグを1にする
If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
checkFlg = 1
End If
End If
Next
If checkFlg <> 1 Then
‘ここで保存
olItem.Save
End If
End With
‘重複フラグリセット
checkFlg = 0
Next
Else
MsgBox “処理を中断します”
End If
‘Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
‘Turn screen updating back on.
Application.ScreenUpdating = True
【VBA】Excel からOutlookの会議出席依頼を送信する方法！会議変更後の送信も対応！
【VBA】Outlook会議通知の重要度を設定する方法！
【Excel VBA】Outlookの他人の予定表をExcelシートへ取り込む方法
【VBA】一瞬で複数ユーザのOutlook予定表をExcelへ取り込む方法！
【VBA】Excelの表をOutlookの予定表へ挿入する方法！画像貼り付けも可！
【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む方法
【VBA】他人のOutlook予定表へExcelから登録、編集、代理送信する方法
【VBA】Excel からOutlookへ終日の予定を登録する方法！複数日指定も！
いつも参考にさせて頂き有難う御座います。
ど素人で申し訳ありませんが、下記ご教授頂きたく宜しくお願いします。
1列に1件名ですが、同列に3つの日付があります。それを件名+”任意文字”という形で3つの日付でOutlookへスケジュール登録したいのですが、可能でしょうか？色々試しましたが上手くいかず、お力添え頂ければ幸いです。
宜しくお願いします。
いつもご利用ありがとうございます。
申し訳ありませんがご質問の内容がいまいち理解できかねますので、
具体的な項目名とサンプルデータを用いてご説明頂いてもよろしいでしょうか？
よろしくお願いいたします。
とても助かりました！
新しい記事まで作成していただき、お忙しいところ本当にありがとうございました。
はじめまして、こちらのコードが本当に便利で大活躍しております。ありがとうございます。
こちらの登録機能に追加で、
Excelのシート2に作成した表をOutlook本文下に画像として挿入
or
Excelに貼った画像を範囲指定しOutlook本文下に画像として挿入したいのですが、この場合どうすればよろしいでしょうか。
自分でも調べてみたのですが、初心者のため他の方の作成されたコードとの兼ね合いが分からず問い合わせさせていただきました。
お忙しいところ恐縮ですがご教示ください。よろしくお願い致します。
ご質問のExcel表画像をOutlook本文に挿入する件につきまして、
以下の記事にまとめましたので、よろしければご参照ください。
https://extan.jp/?p=6605
いつもご利用ありがとうございます。
また活用いただけているということでうれしく思います。
ご質問のExcel表画像をOutlook本文に挿入する件ですが、
対象範囲キャプチャ⇒クリップボード貼り付け⇒Word編集（リッチテキスト）モード⇒Outlook予定本文の指定箇所へキャプチャ画像貼り付け
で対応可能かと存じます。
Wordの参照設定追加やコードなど文書だけでは説明が難しいので、記事に追加したいと思います。
記事への追加が完了しましたらまたご連絡させていただきます。
こんにちは、公開いただいたコードを自身の業務の改善に活用させていただいています。重複スキップ版のコードですが、私のpcで使ってみた所 ”olItemBefor”の部分がコンパイルエラー 変数が定義されていませんと出てしまいます。
とんちんかんな質問かもしれませんが、対処法ご教示いただけないでしょうか？
いつもご利用ありがとうございます。
「変数が定義されていません」と表示されてしまう件につきまして、
お手数ではございますが以下宣言文を追記した上で実行頂けますでしょうか。
Dim olItemBefor As AppointmentItem
よろしくお願いいたします。
別の記事にコメントしてしまいました。。
とても便利なものをありがとうございます。
下記2点変更をしたいのですが可能でしょうか。
・会議出席者がいる場合、会議案内を送るが、出席者がいない場合はそこまま自分の予定表に予定を入力。
・自分の予定の場合は公開方法を空き時間として設定。(予定ありとか外出中とかえらべればなおよい)
お手数ですがお返事いただけるとうれしいです。
いつもご利用ありがとうございます。
一つ目のご質問、「会議出席者がいる場合、会議案内を送るが、出席者がいない場合はそこまま自分の予定表に予定を入力。」につきまして、以下のコードに変更することで対応可能となっております。
■変更前
.Save
■変更後
If Cells(i, 7) = “” Then
.Save ‘必須出席者が空の場合保存のみ
Else
.MeetingStatus = 1 ‘予定を “会議” に設定 ※「olMeeting」でもOK
.Send ‘送信
End If
サンプルコードの.Saveとなっている2か所を変更頂ければと存じます。
メール送信に関する詳細は以下の記事をご参照ください。
https://extan.jp/?p=3636
2つ目のご質問「自分の予定の場合は公開方法を空き時間として設定。」につきましては、BusyStatusプロパティを使用することにより可能となります。
コードは以下になります。
■変更前
.Save
■変更後
If Cells(i, 7) = “” Then
.BusyStatus = Cells(i, 12) ‘予定の公開方法指定。1：仮の予定あり、2：予定あり、3：外出中、0：予定なし
.Save ‘必須出席者が空の場合保存のみ
Else
.MeetingStatus = 1 ‘予定を “会議” に設定 ※「olMeeting」でもOK
.Send ‘送信
End If
BusyStatusプロパティに関する詳細な内容を記事へ追記致しましたので、併せてご参照頂ければと存じます。
https://extan.jp/?p=1693&page=2#%E3%80%90%E8%BF%BD%E5%8A%A0%E3%80%91%E4%BA%88%E5%AE%9A%E8%A1%A8%E3%81%AE%E5%85%AC%E9%96%8B%E6%96%B9%E6%B3%95%E3%82%92%E6%8C%87%E5%AE%9A%E3%81%99%E3%82%8BVBA
なお、今回メール送信機能が追加されておりますので、メール誤送信予防のためテストを行うことを推奨いたします。
よろしくお願いいたします。
思い通りのものが作れました。ありがとうございました。
outlook予定表の時間ではなく、終日の欄に予定を挿入したい場合はどのようなマクロを設定すればよいでしょうか？
こちらの記事へ終日の予定の登録方法についてまとめましたので、よろしければご参照ください。
https://extan.jp/?p=4375
いつもご利用ありがとうございます。
終日の予定の追加の方法につきまして、以下にて対応可能となっております。
■Excelシート
11列目のK列に「終日の予定」フラグを追加します。
・K1に「終日の予定」
・終日の予定にしたい行のK列に「TRUE」と入力します。終日の予定でない場合は「FALSE」としてください。
・日時は日にちのみ入れるか0時指定にします。
■ExcelVBA
.OptionalAttendees = Cells(i, 7)
の下に
.AllDayEvent = Cells(i, 11)
を追加します。※追加する箇所は2箇所となります。
なお、既存の予定のAllDayEventを「TRUE」にすると終日の予定へ変換され、時間帯情報がクリアされますので
テストデータで検証頂きたくお願いいたします。
詳細については別記事にまとめておりますので、完成次第ご案内させて頂きます。
よろしくお願いいたします。
日付、時刻を別々のセルにした場合の対応ですが、
＜日付セル＞ + ＜時刻セル＞
とすることで対応は可能となります。
例えば
C列を開始日、D列を終了日
K列を開始時刻、L列を終了時刻 とした場合は
上記サンプルコードの該当箇所を以下のように修正します。
.Start = Format(Cells(i, 3) + Cells(i, 11), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4) + Cells(i, 12), “yyyy/mm/dd hh:mm:ss”)
※列の位置はご使用のフォーマットにあわせて修正頂ければと思います。
これ、自分の環境だと午前0時に追加されました。
＊なお、日付と時刻が入っているセルの値がシリアル値を保有している必要があり、
文字列形式の場合は機能しないということだけご注意ください。
例えば2021/3/17であれば「44272」9:00:00であれば「0.375」という形となっています。
←セルの値はシリアル値でした。
回答ありがとうございます。
私こちらのコードを勘違いしておりまして、必須出席者のアドレスのOutlookスケジュールに送信されるものと勘違いしておりました。仕様上連絡がされないのですね。私のOutlookアカウントには問題無く登録されていました。
職員は個人PCを持っておらず、アカウントとiPadのみ貸与されているので、職員には会社の共用パソコンに個人でログインしてもらってこちらのVBAを使用させて頂こうと思います。
大変お手数をお掛けして申し訳ございませんでした。
無事できたようで良かったです！
送信機能はセキュリティ的な面からいれておりませんでしたが、
一応お伝えいたしますと、VBAの.saveの部分を以下へ変更すれば送信は可能です。
.MeetingStatus = 1
.Send
即送信されますので、ご使用の前に十分にテストを行うことを推奨いたします。
よろしくお願いいたします。
はじめまして。職場のシフト管理をしており職員のシフトを送信するのにこちらのVBAを役立てたいのですが、基になるExcelのシートで開始時刻と終了時刻の日付と時刻のセルを別にしているのでそちらを変更することは可能でしょうか？
例：開始日 開始時刻 終了日 終了時刻
いつもご利用ありがとうございます。
日付、時刻を別々のセルにした場合の対応ですが、
＜日付セル＞ + ＜時刻セル＞
とすることで対応は可能となります。
例えば
C列を開始日、D列を終了日
K列を開始時刻、L列を終了時刻 とした場合は
上記サンプルコードの該当箇所を以下のように修正します。
.Start = Format(Cells(i, 3) + Cells(i, 11), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4) + Cells(i, 12), “yyyy/mm/dd hh:mm:ss”)
※列の位置はご使用のフォーマットにあわせて修正頂ければと思います。
なお、日付と時刻が入っているセルの値がシリアル値を保有している必要があり、
文字列形式の場合は機能しないということだけご注意ください。
例えば2021/3/17であれば「44272」9:00:00であれば「0.375」という形となっています。
よろしくお願いいたします。
回答ありがとうございます。
A列を件名、B列を開始日、C列を開始時間、D列を終了日、E列を終了時間、F列を参加者のアドレスとしてシートを作成しており、以下のコードで実行してみましたが実行時エラー、型が一致しませんというエラーになりました。
お手数ですがご回答頂けると嬉しいです。
Sub Outlookの予定表へ登録する()
‘Outlook用の定義
Dim olApp As Outlook.Application
Dim olItem As AppointmentItem
‘Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
‘スクリーンの更新は行われません。
Application.ScreenUpdating = False
‘Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(3)
wsSheet.Activate
‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
‘取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox(“予定表へ登録しますか？”, vbYesNo + vbQuestion, “確認”)
If rc = vbYes Then
‘予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
With olItem
.Subject = Cells(i, 1)
.Start = Format(Cells(i, 2) + Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4) + Cells(i, 5), “yyyy/mm/dd hh:mm:ss”)
.RequiredAttendees = Cells(i, 6)
End With
‘ここで保存
olItem.Save
Next
Else
MsgBox “処理を中断します”
End If
‘Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
‘Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox “Outlook予定表の登録が完了しました！”, vbInformation
End Sub
ご連絡ありがとうございます。
頂いたVBAですがこちらの環境で試したことろ問題ありませんでした。
エラー「型が一致しません」ということから、設定した値に問題がある可能性があります。
※エラーの詳細は別の記事にまとめていますのでよろしければご参照ください。
【ご参考】【VBA】実行時エラー’13’「型が一致しません。」が出た場合の確認箇所と対処方法
おそらくですが日付、時刻が文字列のString型になっていて、日付計算のところで整数ではないよ、と怒られている可能性がありますので、
開始日、開始時間、終了日、終了時間の値がシリアル値を保持しているかご確認いただけますでしょうか。
対象セルをコピーして、右クリックで値貼り付けを選択し値が、
例えば2021/3/17であれば「44272」9:00:00であれば「0.375」という形となっているかを見てもらえばと思います。
またデバッグして.Start .End にどういう値が入っているかも確認頂ければと思います。
あと、気になった箇所は、以下で3シート目を指定していますが、
Set wsSheet = wbBook.Worksheets(3)
値を設定したシートが3シート目に位置しているか確認をお願いします。
シートの位置がずれると当然ながら別のシートの値を参照してしまうからです。
よろしくお願いいたします。
回答ありがとうございます。
別のブックを作り直してシートの番号も確認して実行したところエラーは出ませんでしたが、宛先のOutlookの予定表に反映されませんでした。
2行目から1ヶ月間の予定を縦に入力しているのですが
1ヶ月分→エラー無し、Outlookスケジュール反映なし
2列目の1日だけの予定→エラー無し、Outlookスケジュール反映無しとなりました。
以前試しに作ったブックでこちらのコードを使用した際はOutlookの予定表に登録されたのですが、今回作ったブックでは上手くいきません。違いがあるとすれば今回のブックは別のシートに予定時刻をVLOOKUPで予定の番号ごとに時刻を参照する関数を入れている事位です。
何度もお手数をお掛けして申し訳ございません。もしわかる事がありましたらコメント頂ければと思います。
予定時刻をVLOOKUPで参照したパターンでテストしましたが、エラーは無く、登録がされていることを確認できました。
エラーは発生しないがスケジュールが反映されないということですが、可能性としては以下が考えられます。
①時刻が認識されず、開始時刻と終了時刻が同じになってしまっている。
②別のアカウントにスケジュールが登録されてしまっている。
①についてはまずは関数を使用せず、べた書きで時刻を入力した上、
デバッグ実行して値が想定通りになっているか確認し、問題なければ関数を使用した上で再確認をお願いします。
②については規定の（ログインしている）アカウントを確認頂けますでしょうか。
よろしくお願いいたします。
上記のvan ありがとうございます。
Outlookの予定表に追加に関して、
既定の予定表ではなく、新たに作成した予定表に追加したいと考えております。
上記のvanですと既定の予定表に追加になってしまうため何か方法はありますでしょうか？
なお既定ではない予定表の名前はtestで作っています。
よろしくお願い致します。
いつもご利用ありがとうございます。
追加した予定表に対してExcelから予定を登録する方法について確認をすることができました。
詳細は記事にまとめましたので、よろしければご参照ください。
なお、追加した予定表の名前を「test」とする場合は、サンプルコードの48行目を以下のようにしていただければと存じます。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“test”)
よろしくお願いいたします。
いつもご利用ありがとうございます。
原則として既定の予定表のみが取得の対象となっていますので、追加した予定表は対象外となりますことご了承のほどお願いいたします。
なお、他の方からも類似の問い合わせを受けているため、実現方法がないか調査をしておりますので、もしありましたら記事へ追記をしたいと思います。
よろしくお願いいたします。
すごく便利そうなので使用してみたいと思い手探りでやっておりました。
VBAを実行したところコンパイルエラーがでます。
解決方法はありますか？
いつもご利用ありがとうございます。
コンパイルエラーということですが、Outlook Object Libraryの参照設定がされていない可能性がありますので
参照設定をご確認いただけますでしょうか。
手順は、本記事内「Excel VBAからOutlookを操作するための下準備」の内容を
ご参照頂きたくお願いいたします。
上記のvba、ありがとうございます。
更新、高速化共に実感でき、業務の効率化にも役立っております。
本当にありがとうございます。
一つ確認なのですが、
上記のvbaにて、会議設定を相手にすぐに飛ばすことは可能でしょうか？
Outlookの会議開き、送信する手間が無くなればなと考えております。
ご検討よろしくお願い致します。
いつもご利用ありがとうございます。
会議設定をすぐにメール送信する件ですが、Sendメソッドを利用することで実現可能で、
コードの中のSaveメソッドをSendメソッドに置き換えるだけでOKです。
具体的には以下のようにします。
‘.Save
.Send ‘メール送信
なお、即送信となりますので、事前にテストをされることをおすすめいたします。
以下はオプションとなりますが、
送信前にウインドウを表示する場合は、
Displayメソッドを追加します。
‘.Save
.Display ‘ウインドウを表示
.Send ‘メール送信
ドメインに参加しているアドレスであれば、Recipients.ResolveAllメソッドで
受信者の名前解決ができるかチェックができます。
例えば退職者等アドレスが存在しない場合にアラートを発生させることができます。
‘.Save
.Recipients.ResolveAll ‘受信者の名前解決をする
.Display ‘ウインドウを表示
.Send ‘メール送信
よろしくお願いいたします。
回答ありがとうございます。
本日試したのですが、結果的にはまだすぐに会議設定を飛ばすことができておりません…。
saveをsendに変更とのことですが、上記vbaの２ヶ所のsaveをsendに変更で間違いないでしょうか？
またもしかしたら、Outlookで予定をいれるプログラムと会議設定をするプログラムは違ったりするでしょうか？
こちらの使用環境が原因の可能性もありますよね…。
またタイミングがいい時に返答を頂けると助かります。
よろしくお願い致します。
大変失礼いたしました。
コードを一つ失念しておりました。
上記VBAの２ヶ所のsaveの部分を以下へ変更頂けますでしょうか。
.MeetingStatus = 1
.Send
追加したMeetingStatusは予定アイテムの状態を設定するプロパティで、値を「1」にすることにより会議送信前の状態となり、
sendによる送信が可能となります。
よろしくお願いいたします。
一つ質問させてください。
このExcelを複数人で共有して使用したいと考えています。
その際に、予定の更新をExcelから行うことは可能なのか教えてください。
更新の場合には、「予定アイテムのID」を利用する設定になっていると思いますが、
この「予定アイテムのID」は各ユーザーによって同じスケジュールでも登録IDが違うのではないかと思っています。
その場合、一つのExcelを使ってうまく更新をする手立てはありますでしょうか？
お手数ですがご教示いただければ幸いです。
いつもご利用ありがとうございます。
複数人でExcelから予定の更新を行うことは可能かのご質問ですが、
結論としては使い方次第で可能となります。
ご注意いただきたいことは更新をする場合は、
予定表の最新の情報を取得した上で行うようにすることです。
ご認識の通り「予定アイテムのID」は異なる値がOutlook側で発行されますので、同じスケジュールであったとしても
新規予定として追加されてしまいます。
これを避けるためにもOutlook予定に登録されている「予定アイテムのID」を常に取得頂く必要があるというわけです。
本記事でご紹介させて頂いているVBAは予定新規登録後に「予定アイテムのID」を取得する処理を加えていますので、
複数人で使う場合でも、このVBAを実装したExcelを単体で共有して使う分には問題はありません。
例えば共有ファイルサーバにExcelを格納し、複数人が共有ファイルサーバー経由でExcelを参照するといった使い方です。
避けて頂きたいのは複数の方がそれぞれのPCでExcelを持って共有の予定を更新するやりかたです。
この場合には予定登録前に最新の「予定アイテムのID」を取得頂く必要があります。
ご検討の程お願いいたします。
ご回答ありがとうございます。
1つのBookをファイルサーバー等で共有して使う場合には問題ないということでしたが、
例えば最初の1人目が新規でOutlookへ登録をすると、そこで発行されたIDがExcelに書き込まれると思います。
次に2人目がそのExcelを使って同じ予定を新規でOutlookに登録しようとした場合、既にExcelに書かれているIDと比較をすることになると思うのですが、そこで2人目のOutlookから取得したID上にはExcelのIDが存在しないので、Excelに書かれている1人目が発行したIDで2人目のOutookへ登録がされる、という理解で合っていますか？
ちなみに、1人目が発行したIDが2人目の既に登録されている別予定のIDと偶然に一致してしまうという事はありえないでしょうか？IDの附番ルールがわかっていないので合わせて教えていただければと思います。
お手数ですがよろしくお願いします。
お手数ですが、Outlookの利用環境を確認させて頂きたく、
複数人がご利用ということですが、例えばユーザAはユーザAの予定表、ユーザBはユーザBの予定表へ、共有しているエクセルのスケジュール表から登録するということでよろしいでしょうか。
前回回答させて頂いた内容は一つの共有予定表を複数人で使うことを前提としておりましたので、上記の構成でしたら訂正をさせてください。
ご質問の
＞Excelに書かれている1人目が発行したIDで2人目のOutookへ登録がされる、という理解で合っていますか？
についてですが、上記のユーザそれぞれの予定表へ登録する場合はご認識の流れで処理が進みますが、
実行ユーザのOutlook予定表内の予定IDを検索し合致していれば更新するという条件がありますので、
エクセルにIDがあったとしてもOutlook上の予定IDと不一致であれば新規予定として登録され、エクセル側は2人目のIDに変更される形となります。
＞1人目が発行したIDが2人目の既に登録されている別予定のIDと偶然に一致してしまうという事はありえないでしょうか？
予定のIDの発番ロジックについて把握しておりませんので確約は出来かねますが、同じロジックで発番され、それぞれのOutlookで保持しているIDであるため、
重複する可能性はないとは言えないというところでしょうか。
よろしくお願いいたします。
色々とご回答いただきありがとうございます。
1つのExcelで変更処理まで行おうと思うとかなり複雑になりそうなので、運用方法を少し考えて対応してみたいと思います。
お力添え頂きありがとうございました。
ご連絡遅くなりましたが、
以下に1つのExcelで複数ユーザの予定を編集する方法をまとめましたので、
よろしければご参考ください。
https://extan.jp/?p=2849
承知いたしました。
複数ユーザの予定変更マクロは別の機会にでも公開したいと考えていますので、
よかったらご参考頂ければと思います。
よろしくお願いいたします。
複数ユーザの予定更新
ご回答ありがとうございます。
利用環境としては、ユーザAはユーザAの予定表、ユーザBはユーザBの予定表へ、共有しているエクセルのスケジュール表から登録、という形になります。
ご回答内容からすると、
Outlook予定表内のIDとExcelのIDは常に不一致となるので、常に新しく予定が登録されてしまう。
そして、Excelに元々書かれているIDで登録されるわけではなく、新たにその個人のOutlookが発番するIDで登録される。
よって、現在の仕組みだと1つのExcelを共有して複数ユーザー毎の予定表に更新をさせるという事はできなさそう、という理解になりますでしょうか。
ちなみに、各ユーザーが登録を行う前にそのユーザーの現在登録されているスケジュールIDを取得してそれをExcelに反映させてから、新規登録及び更新作業を行うといった手順を踏む作りにすることは可能なのでしょうか？
何度もお手数ですがご確認お願いします。
複数ユーザのOutlook予定表をExcelへ取り込む方法についてまとめましたので良かったらご参考ください。
https://extan.jp/?p=2802
上記の表を利用したExcelからの複数ユーザの予定表の編集は検証をしており、公開する予定です。
＞現在の仕組みだと1つのExcelを共有して複数ユーザー毎の予定表に更新をさせるという事はできなさそう、という理解になりますでしょうか。
ご認識の通り、1つのExcelシートで複数ユーザの予定を管理することは、予定のIDが重複、不整合が生じますので現在の仕様では難しいものと思われます。
もし行うとすればメールアドレス等でユーザを識別する項目を追加し、ユーザ毎に処理を行う必要があります。
＞各ユーザーが登録を行う前にそのユーザーの現在登録されているスケジュールIDを取得してそれをExcelに反映させてから、新規登録及び更新作業を行うといった手順を踏む作りにすることは可能なのでしょうか？
こちらの機能は実現可能です。
指定ユーザーの現在登録されているスケジュールIDを取得する方法については
以下の記事をご参照ください。
https://extan.jp/?p=2243
※指定ユーザではなく実行ユーザの規定のメールボックスを対象にする場合は以下のようにコードを変更してください。
‘以下3点をコメントアウトします。
‘Set recOther = olNamespace.CreateRecipient(strAddress)
‘Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)
‘Set olConItems = olFolder.Items
‘こちらを追記します。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
実行タイミングはマクロ実行ボタンを設置しユーザ側で操作するか、Excelブックを開いたときなどVBAイベントで実行する方法があるかと思います。
その上で最新情報を取得し、
ユーザの予定表を更新するには、実行ユーザの規定のメールボックスの場合は本記事のマクロか、指定ユーザの場合は以下の記事のマクロで実行頂く形になるかと思います。
https://extan.jp/?p=2275
ただこちらも一つのExcelシートで1ユーザの予定を管理することを前提としておりますので、
複数ユーザの予定情報を管理する場合はシートやブックを分けたほうがよいでしょう。
本日、はじめ活用させていただいたところ、Outlookにしっかり反映されました！
ありがとうございます。
一つ質問なのですが、会議日時が変更になった際、前の会議設定を消して、新たな会議設定を入れる(連動させる)ことは可能でしょうか？
いつもご利用ありがとうございます。
一度登録した会議設定を更新（連動）することは可能です。
会議設定をするとOutlook側ではその会議に対してID（EntryIDと呼ばれます）が発行されますので、
更新の際はそのIDを手掛かりに会議設定をおこなうという流れとなります。
以下のマクロは本文のエクセルのリストから会議設定を行うものに対して、エクセルのI列に新規会議の場合はIDをI列に追記、更新の場合はI列のIDをみて該当するIDの会議設定を行うように処理を加えたものです。
一度サンプルで新規登録から変更（タイトル、開始日、終了日）まで試していただければと存じます。
なお出席者や本文単体の更新はできませんが、変更したい場合は以下のif文の条件を緩和してみてください。
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
Sub Outlookの予定表へ登録する_重複スキップ_エクセルリストから変更できる版()
‘Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim checkFlg As Long
‘重複チェックフラグ初期値設定
checkFlg = 0
‘Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
‘スクリーンの更新は行われません。
Application.ScreenUpdating = False
‘Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
‘取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox(“予定表へ登録しますか？”, vbYesNo + vbQuestion, “確認”)
If rc = vbYes Then
‘予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
‘重複チェック＆更新処理
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = “AppointmentItem” Then
‘エクセルI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新
If olItemBefor.EntryID = Cells(i, 9) Then
‘比較用に一時的に作成
With olItem
.Subject = Cells(i, 1)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
End With
‘重複フラグ1をセット
checkFlg = 1
‘登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
‘※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
Else
With olItemBefor
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
.Save
End With
End If
‘Null out the variables.
Set olItem = Nothing
End If
End If
Next
If checkFlg 1 Then
‘エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録
With olItem
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
.Save
End With
‘エクセルI列へ発行されたEntryIDを書き込み
Cells(i, 9) = olItem.EntryID
End If
‘重複フラグリセット
checkFlg = 0
Next
Else
MsgBox “処理を中断します”
End If
‘Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
‘Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox “Outlook予定表の登録が完了しました！”, vbInformation
End Sub
ご査収の程、お願いいたします。
お礼が大変遅くなり、申し訳ありません。
無事に更新できるようになりました！
追加で申し訳ないのですが、上記のプログラムの動作を軽くすることは可能でしょうか？
いろいろ自分でも試しているのですが、どうしても1回、2～3分程度かかってしまいます…。
本記事の「予定アイテム更新処理<高速版>」へサンプルを掲載しましたので、よかったらご参考ください。
高速化、ありがとうございました！
無事にすることができました！
毎回、お礼がおそくなり申し訳ありません…。
自分でもできるように、勉強します！
お役に立ててうれしく思います！
処理時間が2~3分かかってしまう件ですが、予定IDをチェックするときに登録されている予定表の予定アイテムをすべて確認する処理を行うため、
Outlookを何年も使っている方や、予定を密に入れられている方など予定アイテムを多く保持している方は処理時間が長くなってしまう傾向があります。
現在、処理時間の短縮を図るために対象期間を絞るなどしてチェック対象を少なくできないか検討中ですので、
お待ちいただきたくお願いいたします。
お手数をおかけし、申し訳ありません。
自分の勉強不足を実感しております…。
ちなみに予定は最大でも前後2週間程度しかずれません。
よろしくお願いいたします。
お世話になります。
重複した場合の設定などご教示いただけませんでしょうか？
例えばその場合は作業を停止するなど
いつもご利用ありがとうございます。
重複した場合の設定についてですが、重複フラグを設け、
予定表の件名と開始日時が一致していたらフラグを1にし、
その場合は予定表の登録をスキップする処理にしてみました。
また、記事本文にも追記させ頂きました。
ご査収の程お願いいたします。
Sub Outlookの予定表へ登録する_重複スキップ版()
‘Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem As AppointmentItem
Dim checkFlg As Long
‘重複チェックフラグ初期値設定
checkFlg = 0
‘Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
‘スクリーンの更新は行われません。
Application.ScreenUpdating = False
‘Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
wsSheet.Activate
‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items
‘取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
Dim rc As Integer
rc = MsgBox(“予定表へ登録しますか？”, vbYesNo + vbQuestion, “確認”)
If rc = vbYes Then
‘予定表一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 1).End(xlDown).Row
Set olItem = olApp.CreateItem(olAppointmentItem)
With olItem
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 6)
.OptionalAttendees = Cells(i, 7)
‘重複チェック
For Each olItemBefor In olConItems
If TypeName(olItemBefor) = “AppointmentItem” Then
‘登録されている予定表の件名と開始日時が一致していたらフラグを1にする
If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
checkFlg = 1
End If
End If
Next
If checkFlg <> 1 Then
‘ここで保存
olItem.Save
End If
End With
‘重複フラグリセット
checkFlg = 0
Next
Else
MsgBox “処理を中断します”
End If
‘Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
‘Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox “Outlook予定表の登録が完了しました！”, vbInformation
End Sub