共有メールフォルダ取得で エラー -2147221233：実行しようとした操作が失敗しました。オブジェクトが見つかりませんでした。

Question

Window10、Excel2016のVBAマクロでOutlookのメール移動処理を実装しています。
Outlookで使用しているアカウントは共有メールアカウントです。

予めOutlookのDraftフォルダ(下書きフォルダ)下にサブフォルダを作成しており、
これを取得しようとすると以下のようなエラーになります。

エラーコード：-2147221233
エラーメッセージ：実行しようとした操作が失敗しました。オブジェクトが見つかりませんでした。

エラーになる場合とならない場合がある為、フォルダ名の整合性やVBAコードに問題はないと考えています。
エラーになる場合とならない場合の違いはわかっていません。

原因や解決策をご存知の方はいらっしゃいませんでしょうか？

よろしくお願いします。

<VBAコード>　※フォルダ取得部分のみ

Dim objOutlook As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myInbox As Outlook.Folder
Dim draftsFolder As Outlook.Folder
Dim processedFolder As Outlook.Folder
Dim recOther As Recipient    ' Outlook オブジェクトを作成する

Set objOutlook = GetObject(, "Outlook.application")        ' ネームスペース取得

Set myNamespace = objOutlook.GetNamespace(NAMESPACE_MAPI)        ' 共有メールボックスの受信トレイを取得

Set recOther = myNamespace.CreateRecipient(cnfIcrMailRcvAccount)    ' 共有メールアカウントを指定

Set myInbox = myNamespace.GetSharedDefaultFolder(recOther, olFolderInbox) ' Inboxフォルダ

Set draftsFolder = myNamespace.GetSharedDefaultFolder(recOther, olFolderDrafts) ' draftフォルダ

Set processedFolder = draftsFolder.Folders(cnfIcrMailProcessedFolder)   'Draft下のサブフォルダ  ※ここで例外発生

' ....以下略...

(追記)

共有メールアカウントと同期が取れていない為と予想し、以下を試してみましたが、いずれもうまくいきませんでした。

• Outlookで全て送受信してから実行
• Outlookで当該サブフォルダにあるメールを表示してから実行
• Outlookで当該サブフォルダを選択してフォルダーの更新をしてから実行
  

Answer 1

mtanaさん、こんにちは。

小生、再現試行ができておりません。よくわからない点も多いのですが、とりあえず、気づきの点を投稿します。

cnfIcrMailProcessedFolder は目的のDragt下のサブフォルダの名前を格納している変数であると思いますが、そのサブフォルダが見つからないのが原因ではないかと疑わしく思われます。共有フォルダですと誰かがフォルダを変えてしまうことがよくありがちかと。で、例外が発生するSet文の代わりに、

Dim sFolders As Outlook.Folders
Dim sF As Outlook.Folder
Set sFolders = draftsFolder.Folders
For Each sF In sFolders
    Debug.Print ">" & sF.Name & "<"
Next sF

を記入して、傘下のサブフォルダ名をイミディエイトウィンドウに打ち出して確認してみてはいかがでしょうか。なお、">""<"は、スペースの有無をチェックするために前後に付加しているものです。もうすでに確認済みであれば、ごめんなさい。

このほか考えられるとすれば、共有メールアカウントならではの現象で、他者がアクセス中はエラーになる、とかですが、それらしい記事はネット上では見つけられませんでした。当方では試してみることもできず、申し訳ありません。あしからず…。

Answer 2

KokemomoYamamomoさん、ご返信ありがとうございます。

変数名をそのまま使ってしまい、失礼しました。(cnfIcrMailRcvAccount、cnfIcrMailProcessedFolder)

私もこの投稿の後にFoldersの中身を確認することを思いつき、提案いただいたfor each、インデックス指定、GetFirstでサブフォルダを取得してみました。

結果、Foldersには一つもサブフォルダがありませんでした。

KokemomoYamamomoさんのおっしゃる通り、サブフォルダが取得できていないのにフォルダ名指定で取得しようとした為に発生したエラーと思います。

となると、Draft下のサブフォルダはOutlookからは見えてるのに(かつサブフォルダ内のメールを表示できるのに)VBAマクロからは見れない状態である、ということになります。

共有メールボックスであることやDraft下であることが関係しているかもしれません。もう少し調べてみたいと思います。

Answer 3

mtanaさん、こんにちは。

推測が当たっていて、よかったような、残念なような、です。上から目線みたいで恐縮ですが、小生がいつもしていることなのですが、1ステップずつ、set文で得られたオブジェクトをチェックしていくことをお勧めします。

Answer 4

こんにちは。

GetSharedDefaultFolderメソッドで下書きフォルダが取得できていないのかもしれません。
KokemomoYamamomoさんが仰っているように、Stopを挟むなりして一行ずつ確認することをお薦めいたします。

Public Sub Sample()
  Dim appOl As Object
  Dim rp As Object 'Outlook.Recipient
  Dim fol As Object 'Outlook.Folder
  Dim f As Object 'Outlook.Folder
  Const olFolderDrafts = 16
  
  On Error Resume Next
  Set appOl = GetObject(, "Outlook.Application")
  On Error GoTo 0
  If appOl Is Nothing Then Exit Sub
  With appOl
    Set rp = .Session.CreateRecipient("(共有メールアカウント)")
    rp.Resolve
    If rp.Resolved Then
      Set fol = .Session.GetSharedDefaultFolder(rp, olFolderDrafts)
      Stop
      Debug.Print fol.Name, fol.Folders.Count
      For Each f In fol.Folders
        Debug.Print f.Name, f.Items.Count
        Stop
      Next
    End If
  End With
End Sub

Answer 5

きぬあささん、ご返信ありがとうございます。

以下で取得した下書きフォルダは取得できていました。(デバッガで確認)

Set draftsFolder = myNamespace.GetSharedDefaultFolder(recOther, olFolderDrafts) ' draftフォルダ

ですが、draftsFolder.Foldersが空っぽで存在するはずのサブフォルダが全く取得できていませんでした。

きぬあささんのコードでいうと「fol.Folders.Count」が0になる状態です。

なぜOutlookからは見えているのにマクロからは取得できないのか、未だ解決しておりません。。。

Answer 6

キャッシュから読み込んでいるのが原因かもしれません。
Exchange キャッシュ モード( https://support.office.com/ja-jp/article/7885af08-9a60-4ec3-850a-e221c1ed0c1c )の有効・無効を確認し、「共有フォルダーをダウンロード」が有効になっているのであれば、一度無効にして動作を確認してはいかがでしょうか。