Q&A
前提・実現したいこと
現在Excelで職場のスケジュール管理を行っています。
一カ月の予定表を職員それぞれのOutlookのスケジュールに同期させたいのですが、良いやり方が見つからず困っています。職員は主にiPadで業務をしていて、今のところ手動でそれぞれOutlookの予定表に書き込む等しています。一カ月の予定はそれぞれ決まっているのでシフトが出た時点でそれぞれのアドレスに送信できれば便利だと考えています。
VBAは初心者で、ネットで紹介されているコードを幾つか試しましたが上手くいかず、アドバイス頂きたいと存じます。
発生している問題・エラーメッセージ
https://officevba.info/outlookschedule/
こちらのサイトで紹介されているコードを試してみたのですが、VBAを実行したPCのOutlookアカウントに直接予定表が書き込まれてしまい、アカウントを指定して送る意図通りにいきません。
### 該当のソースコード ```ここに言語名を入力 ソースコード
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
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).Text
開始時間 = Cells(i, 4).Text
終了日 = Cells(i, 5).Text
終了時間 = Cells(i, 6).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
試したこと
こちらのサイトのコードも使用してみましたが、日付と時間が同じセルの為
基になるExcelのシートの書式に合わず使えませんでした
補足情報（FW/ツールのバージョンなど）
ここにより詳細な情報を記載してください。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/03/14 04:40
2021/03/14 04:49
2021/03/14 05:24
2021/03/14 05:47
2021/03/16 10:51
2021/03/16 10:59
2021/03/16 12:32 編集
2021/03/16 12:43