共享收件箱子文件夹在 VBA 中不可见

Shared Inbox Subfolder not visible within VBA

我有一个几天前有效的例程,但现在挂断了 Set SubFolder = oInbox.Folders("ProcessedForms")

在执行期间在即时窗格中选中收件箱时,收件箱有 0(零)个文件夹。 ?oInbox.Folders.Count.

我检查了 Office 365 在线和我计算机上的 Outlook 应用程序,有一个名为 'ProcessedForms' 的子文件夹。

完整代码如下:

Private Sub ScrapeOutlook(fileName As String, subject As String)
    Dim intFileNum As Integer
    Dim SubFolder As Outlook.MAPIFolder
    
    On Error GoTo ScrapeOutlookErr
    
    'Get the inbox from Outlook
    Set oApp = New Outlook.Application
    Set NS = oApp.Session
    Set objOwner = NS.CreateRecipient("main@mycompany.com")
    objOwner.Resolve

    If objOwner.Resolved Then
        Set oInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set Application.ActiveExplorer.CurrentFolder = oInbox
    End If
    
    If Not TESTING Then Set SubFolder = oInbox.Folders("ProcessedForms")
    
    'Filter the items from the inbox based on the sender
    Set oRestrictItems = oInbox.Items.Restrict("[Subject] = '" & subject & "'")

    intFileNum = FreeFile
    Open fileName For Output As intFileNum
    itemsScraped = 0
    For Each oLatestItem In oRestrictItems
        Print #intFileNum, Replace( _
                            Replace( _
                             Replace( _
                              Replace( _
                               Replace(oLatestItem.Body, ",", "%") _
                              , vbNewLine, ",") _
                             , vbTab, ",") _
                            , ", ,Sent from Mycompany <https://mycompany.com>  ,", "") _
                           , ", ,", ",") & ",Time," & oLatestItem.SentOn
        If Not TESTING Then oLatestItem.UnRead = False
        'If Not TESTING Then oLatestItem.Move SubFolder
        itemsScraped = itemsScraped + 1
    Next oLatestItem
    Close #intFileNum
    
    
ScrapeOutlookExit:
    Exit Sub
    
ScrapeOutlookErr:
    HandleError "NewCustomers.ScrapeOutlook()"
    Resume ScrapeOutlookExit
    Resume
    
End Sub

GetSharedDefaultFolder 缓存在主邮箱的 OST 文件中的文件夹不包含子文件夹。取消选中 Exchange 帐户属性中的“下载共享文件夹”复选框,或在配置文件中将父邮箱作为代理邮箱打开,以便所有文件夹在 Outlook 中可用和可见。

如果文件夹在导航窗格中可见,您可以尝试:

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Private Sub ScrapeOutlook(fileName As String, subject As String)

    Dim mailBox As Folder
    Dim oInbox As Folder
    Dim subFolder As Folder
    
    'No error handling during debugging.
    
    Set mailBox = Session.Folders("main@mycompany.com")
    Set oInbox = mailBox.Folders("Inbox")
        
    Debug.Print oInbox.Folders.count
    
    If oInbox.Folders.count > 0 Then
        Set subFolder = oInbox.Folders("ProcessedForms")
        Set ActiveExplorer.CurrentFolder = subFolder
    Else
        Debug.Print "No subfolders found."
    End If
    
End Sub


Private Sub test_ScrapeOutlook()
    ScrapeOutlook "dummyFilename", "dummySubject"
End Sub