VBAでOutlookの下書きフォルダにあるメールを自動送信させたい

Question

前提・実現したいこと

VBAでOutlookの下書きフォルダにあるメールをVBAに送らせるツールを作成しておりますが、
メールの件数に応じてうまく送信することができません。

発生している問題・エラーメッセージ

実行時エラー’2147467259（80004005）
このメソッドは、インラインの応答メールアイテムと共には使えません。

該当のソースコード

Sub Macro3()

Dim oApp As New Outlook.Application
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Path As String, WSH As Variant
Set WSH = CreateObject("Wscript.Shell")
Dim DesktopPath As String
DesktopPath = WSH.SpecialFolders("Desktop")

Dim oAcct
Dim oStore

Dim oFolder
Dim cITEM
Dim go As Integer, bo As Integer, l As Integer

Set oAcct = oApp.Session.Accounts("メールアドレス")
Set oStore = oAcct.DeliveryStore

Set oFolder = oStore.GetDefaultFolder(16)

If oFolder.Items.Count = 0 Then
Exit Sub
End If

For go = 1 To oFolder.Items.Count
Set cITEM = oFolder.Items(go)

On Error GoTo 次の下書きメール送信

cITEM.Send 

　　Set cITEM = Nothing
On Error GoTo 0

Next

Set oFolder = Nothing
Set FSO = Nothing
'

Exit Sub

次の下書きメール送信:

cITEM.Close 0
l = go + 1
Resume Next

End Sub

VBA

試したこと

2通作成してマクロを走らせ1通目は送れるが2通目が送れない。
1通作成してマクロを走らせ1通目でエラーになり「cITEM.Close 0」のところでデバックとなります。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

下書きから送信された時、下書きから送信トレイや送信済みなどに移動されるので、
oFolder.Items オブジェクトの数が変わってくるので、
Forのカウンターが進む(+1される)けど
下書きの件数が一つ減るので、エラーになるのでは？

For go = 1 To oFolder.Items.Count
Set cITEM = oFolder.Items(go)

On Error GoTo 次の下書きメール送信

cITEM.Send '←※ここで、oFolder.Itemsが更新されるので下書きが一つ減るので
Set cITEM = Nothing
On Error GoTo 0

Next

修正案:ループを後ろから回すように変更するとか？
For go = oFolder.Items.Count To 1 Step -1
Set cITEM = oFolder.Items(go) '後ろからメールitemを取り出す

On Error GoTo 次の下書きメール送信

cITEM.Send '←※ここで下書き、oFolder.Itemsが更新されても、ループがStep -1なのでOK?
Set cITEM = Nothing
On Error GoTo 0
Next

あっ
＞実行時エラー’2147467259（80004005）
＞このメソッドは、インラインの応答メールアイテムと共には使えません。
↑エラーメッセージの内容が違うので、外しているかな

ループを後ろから回す修正案で、よけいに混乱させてしまったらすみせん。
解決の糸口となれば幸いです。

恥ずかしいけど下記、メールの移動で私がやった同じようなミス
https://www.youtube.com/watch?v=I4XZYWltfqA
https://ken3memo.hatenablog.com/entry/2019/06/06/080000