ormonds Ответов: 1

Excel VBA проблемы с доступом к общему почтовому ящику в office365

Я хочу получить количество почтовых отправлений в каждом из общих почтовых ящиков нашей компании.
Моя электронная таблица содержит в столбце А список всех таких почтовых ящиков. Я хочу поместить количество почтовых отправлений в колонку B.
Мой код:-

Sub HowManyEmails()
Dim objOL As Object
Dim objNS As Object
Dim objFolder As MAPIFolder
Dim EmailCount As Integer
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
ThisRow = 1
While ThisRow < 999
    Range("A" & ThisRow).Select
    ThisFolder = ActiveCell.Value
    ThisFolder = Trim(ThisFolder)
    If ThisFolder = "" Then
        Exit Sub
    Else
        Set objFolder = objNS.Folders(ThisFolder)
        EmailCount = objFolder.Items.Count
        ThisRow = ThisRow + 1
        Range("B" & ThisRow).Select
        ActiveCell.Value = EmailCount
    End If
Wend
End Sub


Строка после Else "Set objFolder = objNS.Folders(ThisFolder)" выдает ошибку времени выполнения '-2147221233 (8004010f)'.
Короче говоря, как мне получить доступ к общим папкам? Существует ли имя папки для хранилища, в котором размещаются общие папки в Office 365?

Что я уже пробовал:

Я нашел много страниц, ссылающихся на эту проблему, поэтому использовал различные альтернативные способы ее кодирования, но получил тот же результат.

CHill60

Каково было полное сообщение об ошибке?
Когда вы отлаживаете это значение objNS - Ничего?
В чем заключается содержание ThisFolder - это имя папки действительно существует?

1 Ответов

Рейтинг:
7

CHill60

Эта ошибка означает, что папка не существует в этой "области" Outlook.

Если вы отлаживаете свой код и наблюдаете за содержимым objNS вы поймете, что он содержит список почтовых ящиков, а не список папок в почтовом ящике.

Вам нужно сначала "указать" на соответствующий почтовый ящик, а затем получить список папок, например

Dim objItems As Variant
Set objItems = Session.GetDefaultFolder(olFolderInbox).Parent.Folders
Существуют методы поиска других почтовых ящиков (общий доступ, приглашение и т. д.), описанные здесь - Работа с папками Outlook VBA и нестандартными папками Outlook[^]

Вам все равно нужно будет правильно обработать эту ошибку, поскольку вы полностью полагаетесь на то, что кто-то правильно введет имя папки. Есть и другие проблемы с вашим кодом …

* Вы должны полностью квалифицировать диапазон, который вы используете, например
ThisWorkbook.Sheets(1).Range("A" & ThisRow).Value
* Вам следует избегать использования ActiveCell .. зачем использовать две строки кода, когда одна будет делать, но важно, что другой код или действия пользователя могут "захватить" ActiveCell. 
Range("B" & ThisRow).Select
ActiveCell.Value = EmailCount
становится
ThisWorkbook.Sheets(1).Range("B" & ThisRow).Value = EmailCount
* Вы увеличиваете ThisRow прежде чем вы обновите счетчик на листе, чтобы все было смещено на 1

Лично я бы использовал a для каждого цикла, а не полагался на то, что список будет обновляться, и Вам, вероятно, придется иметь рекурсивный вызов для обработки подпапок.

Взгляните на это vba - могу ли я перебирать все электронные письма Outlook в папке, включая подпапки? - переполнение стека[^]

Вероятно, что - то вроде следующего-хотя обратите внимание, что я еще не проверил это полностью
Sub HowManyEmails()
    Dim objOL As Object
    Set objOL = CreateObject("Outlook.Application")
    
    Dim objNS As Object
    Set objNS = objOL.GetNamespace("MAPI")
    
    Dim EmailCount As Integer
    Dim ThisRow As Integer
    ThisRow = 0
    Dim count As Long
    Dim objFolder As Variant
    For Each objFolder In objNS.Folders
        count = 0
        ThisRow = ThisRow + 1
        ThisWorkbook.Sheets(1).Range("A" & ThisRow).Value = objFolder.Name
        ThisWorkbook.Sheets(1).Range("B" & ThisRow).Value = objFolder.Items.count
        count = count + HowManyEmailsInFolder(objFolder)
        Debug.Print objFolder.Name
    Next
End Sub
Private Function HowManyEmailsInFolder(ByVal oParent As Outlook.MAPIFolder) As Long

    Dim oFolder As Outlook.MAPIFolder
    Dim oMail As Outlook.MailItem
    Dim numEmails As Long
    numEmails = numEmails + oParent.Items.count

    If (oParent.Folders.count > 0) Then
        For Each oFolder In oParent.Folders
            numEmails = numEmails + HowManyEmailsInFolder(oFolder)
        Next
    End If
    
    HowManyEmailsInFolder = numEmails
End Function

ormonds

Спасибо, я поработаю над этим сегодня.
Вложенных папок нет, и список в столбце А правильный, он был выведен в текст из команды Powershell со списком всех папок.

ormonds

Это сработало, но не совсем так, как я ожидал - он перечислил все объекты на моей личной машине, включая те общие папки, в которых я являюсь делегатом. Я запишу еще один вопрос о том, как получить все общие папки и только их - я администратор Exchange, так что это должно быть возможно.
Спасибо за вашу помощь.

CHill60

Удачи, рад, что смог помочь.
К сожалению, из - за моей установки здесь я не могу помочь дальше с этим уровнем детализации-следовательно, не могу полностью протестировать то, что я сделал.
Возможно, стоит поставить часы на objFolder и посмотреть на свойства - из памяти есть способ отличить общие папки, но детали ускользают от меня.