OUTLOOK研修所から以前に問い合わせについての解答をいただきましたが，私の環境で，なかなか実現でき
ませんでした。実現できなかった原因は，そもそも，設定仕方等が，全く違っていたのです。それに，肝
心のこと忘れていました。イベントを受け取るにには，プロシージャが終了していては，いけないのです。
肝心要のこのことも抜けていました。それで，copilotにしつこく聞いたり，google先生をたよったりして，
本日やっと実現できました。
まず，OUTLOOKのイベントをつかむには，
Public WithEvents mySentItems As Outlook.Itemsを書く必要がありますが，このコードは，クラスモジュールに書かなければいけにようです。同時に，
OUTLOOK研究所でおしえてもらった，サブルーチン等も，クラスモジュールに置く必要があるようで，標
準モジュール等に置くと，エラーになります。また，クラスモジュールにおいたサブルーチンを呼ぶには
手続きがいるようで，これも抜けていたようです。下記がClassモジュールにおいたものの全文です。
Option Explicit
Public myOutlookApp As Outlook.Application
Public mySentFolder As Outlook.Folder
Public WithEvents mySentItems As Outlook.Items
Private Sub Class_Initialize()
Set myOutlookApp = Nothing 'objoutlookの初期値これがないとGetObjectに失敗するとobjoutlookはemptyのまま
On Error Resume Next
Set myOutlookApp = GetObject(, "Outlook.Application") '起動済みのOutlookをクラス名を指定して取得
On Error GoTo 0
If myOutlookApp Is Nothing Then 'objoutlookがNothingなら
Set myOutlookApp = CreateObject("Outlook.Application") 'Outlookを起動
End If
Dim oNS As Namespace
Set oNS = myOutlookApp.GetNamespace("MAPI")
Set mySentFolder = oNS.GetDefaultFolder(olFolderSentMail)
Set mySentItems = mySentFolder.Items
End Sub
Public Sub AddTrackInfo(ByVal objMail As MailItem, iRow As Integer, iCol As Integer)
Dim olkApp As Outlook.Application
Dim fldSentMail As Folder
Dim strTrackInfo As String
Dim propTrack As UserProperty
' 送信済みアイテム フォルダーを取得
Set fldSentMail = objMail.Application.Session.GetDefaultFolder(olFolderSentMail)
' mySentItems が設定されていなければ送信済みアイテム フォルダーの Items を設定
If mySentItems Is Nothing Then
Set mySentItems = fldSentMail.Items
End If
' メールに送信後の保存先フォルダーを設定
Set objMail.SaveSentMessageFolder = fldSentMail
' 送信状況を追跡するためのプロパティを設定
Set propTrack = objMail.UserProperties.Add("TrackInfo", olText, True)
' 送信日時を保存するセルの行番号と列番号を設定
propTrack.Value = iRow & "," & iCol
End Sub
' 送信済みアイテム フォルダーにアイテムが追加されたときに実行されるイベント
Public Sub mySentItems_ItemAdd(ByVal Item As Object)
Dim objMail As MailItem
Dim propTrack As UserProperty
Set objMail = Item
' 送信状況を追跡するプロパティの確認
Set propTrack = objMail.UserProperties.Find("TrackInfo")
' プロパティが存在したら
If Not propTrack Is Nothing Then
Dim arrRC As Variant
' 送信日時を保存するセルの行番号と列番号を取得
arrRC = Split(propTrack.Value, ",")
' 取得した行、列のセルに送信日時を保存
Sheet1.Cells(CInt(arrRC(0)), CInt(arrRC(1))).Value = objMail.SentOn
End If
End Subこれを実行するには，標準モジュール等から，このクラスモジュールのサブルーチンを下記のようにして
呼び出します。VBAを終了しないよううに，最後にユーザーフォームを表示してます。
Public Function Mail_Sousin()
▼
詳細設定略
▲
Dim clsSample1 As Class1 'Class1型のオブジェクト変数を宣言 「Class1」はクラスモジュール名
Set clsSample1 = New Class1
Call clsSample1.AddTrackInfo(objItem, 4, 9) 'objItemは，送信するメール本体4，9はRange(4,9)で
送信日時を記録すすセル
If jidou_sousin_flag = False Then
objItem.Display '送信画面を表示
End If
If jidou_sousin_flag = True Then
objItem.Send '自動で送信
End If
UserForm1.Show
Set olkApp = Nothing
Set objItem = Nothing
Set acctToSend = Nothing
End Function
クラスモジュールのサブルーチンを呼ぶには，インスタンス？を下記のように作成しないとだめみたいでした。
Dim clsSample1 As Class1 'Class1型のオブジェクト変数を宣言 「Class1」はクラスモジュール名
Set clsSample1 = New Class1
Call clsSample1.AddTrackInfo(objItem, 4, 9)なお，一番参考になったのは，外国の掲示板でした。
