EXCELのVBAからOutlookの会議依頼してみる

とある作業はEXCELのボタンを押せばある程度簡単に作業できるところまではやったんだけど作業自体が漏れてしまうということがあって、何とかできないかなぁと思っていました。色々とどんな手があるかと考えていたら。Outlookには予定表なるものがあるじゃないですか。なのでそれを使ってリマインダーしてみようと挑戦。OutlookのVBAがあるらしいですが、Outlookは難しそうなのと引継の時とかにEXCELシートで1年分のアラートをまとめて登録することも視野に入れていたのでEXCEL/VBAで実装してみました。

アラートだけなので会議出席依頼の返信不要オプションを指定して複数人でアラートを共有するようなことで考えています。

とりあえず意図通り動いてくれましたよ。100%コピペです。
そしてエラー実装ゼロ、まぁ落ちても被害はそこまで大きくないので、、、、

しかしシステムの仕事長いのに未だに綺麗なコード書けないし、変数の命名とかダメダメだし、テストコード書けないほぼ素人なので今年こそは何とかしたいんですけどね。

◆参照サイト
https://outlooklab.wordpress.com/2012/05/19/excel-%E3%81%AE%E3%83%87%E3%83%BC%E3%82%BF%E3%82%92%E3%82%82%E3%81%A8%E3%81%AB%E4%BC%9A%E8%AD%B0%E5%87%BA%E5%B8%AD%E4%BE%9D%E9%A0%BC%E3%82%92%E9%80%81%E4%BF%A1%E3%81%99%E3%82%8B%E3%83%9E%E3%82%AF/
http://www.ken3.org/cgi-bin/group/vba_outlook_Appointment.asp
https://oshiete.goo.ne.jp/qa/5722929.html
http://jus7733.hatenablog.com/entry/2015/05/27/164738
http://officevba.info/outlookschedule/
https://docs.microsoft.com/ja-jp/office/vba/api/outlook.appointmentitem.send(method)
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11129488786

◆ソースコード

Option Explicit
Sub startmod()

    Dim tn As String
    Dim st As String
    Dim et As String
    Dim bc As String
    Dim at As Variant
    
    tn = "EXCELからOutlookに予定登録テスト"
    st = CDate("2019/4/1") & " " & CDate("11:00")
    et = CDate("2019/4/1") & " " & CDate("12:00")
    bc = "テストです" & vbCrLf & "新元号発表"
    
    at = Array("test1@sample.com", "test2@sample.com")

    Call setSchedule(tn, st, et, bc, at)
    MsgBox ("end")

End Sub

'
' Outlook会議出席依頼登録
'
Function setSchedule(titleName As String, startTime As Variant, endTime As Variant, bodyContent As String, attendee As Variant)

    Dim oApp As Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myFolder  As Outlook.Folder
    Dim i As Long

    Set oApp = CreateObject("Outlook.Application")
    Set myNameSpace = oApp.GetNamespace("MAPI")

    Set myFolder = myNameSpace.GetDefaultFolder(6)
    myFolder.Display
    oApp.ActiveWindow.WindowState = 2
    Dim aITEM As Outlook.AppointmentItem
    Set aITEM = oApp.CreateItem(1)
    
    '会議依頼データのセット
    With aITEM
        .Subject = titleName
        .Body = bodyContent
        .start = startTime
        .End = endTime
        .MeetingStatus = 1
        If IsArray(attendee) = False Then
            aITEM.Close 0
            Set aITEM = Nothing
            oApp.Explorers.Item(oApp.Explorers.Count).Close
            Exit Function
        Else
            For i = LBound(attendee) To UBound(attendee)
                    .Recipients.Add attendee(i)
            Next
        End If
        .ResponseRequested = False
        .Send
    End With
 
    aITEM.Save
    aITEM.Close 0
    Set aITEM = Nothing
    oApp.Explorers.Item(oApp.Explorers.Count).Close

End Function