Как обратиться к вложениям в письмах на втором аккаунте аутлук через макрос Exce

[johnyb]

Здравствуйте, многоуважаемые гуру!
Не могу решить проблему с обработкой и архивацией писем с доп. аккаунта в аутлуке, через макрос эксель.
Есть такой код:
Код

Код (vb) Выделить Развернуть

Sub mail_attachments_download()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim objOutlApp As Object, oNSpace As Object, oIncoming As Object
Dim oIncMails As Object, oMail As Object, oAtch As Object
Dim IsNotAppRun As Boolean
Dim sFolder As String, st As String, bodym As String
Application.ScreenUpdating = False
actbk = ThisWorkbook.Name
On Error Resume Next
Set objOutlApp = GetObject(, "outlook.Application")
If objOutlApp Is Nothing Then
    Set objOutlApp = CreateObject("outlook.Application")
    IsNotAppRun = True
End If


Set oNSpace = objOutlApp.GetNamespace("MAPI")
Set oIncoming = oNSpace.GetDefaultFolder(6)
Set oIncMails = oIncoming.Items


    For Each oMail In oIncMails.Restrict("[Unread]=TRUE")
        For Each oAtch In oMail.Attachments
            For i = 2 To Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Rows.Count
                If InStr(1, oAtch, Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Cells(i, 1).Value, vbTextCompare) <> 0 Then
                    If Right(oAtch, 4) = ".xls" Then
                        mnslft = 4
                    Else
                        mnslft = 5
                    End If
                    sFolder = Workbooks(actbk).Worksheets(2).UsedRange.Cells(i, 2).Value
                    If Right(sFolder, 1) <> "\" Then
                        sFolder = sFolder & "\"
                    End If
                    oAtch1 = Left(oAtch, Len(oAtch) - mnslft) & " (Downloaded " & Left(Now, 10) & ")" & Right(oAtch, mnslft)
                    oAtch3 = Left(oAtch, Len(oAtch) - mnslft) & " (Downloaded " & Left(Now, 13) & "h" & Left(Right(Now, 5), 2) & "m" & Right(Now, 2) & "s)"
                    st = sFolder & oAtch1
                    oAtch.SaveAsFile st
                    n = Workbooks(actbk).Worksheets("Archive page").UsedRange.Rows.Count + 1
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 1).Value = Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Cells(i, 1).Value
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 2).Value = oMail.Sender.GetExchangeUser.PrimarySmtpAddress
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 3).Value = oAtch
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 4).FormulaR1C1 = "=HYPERLINK(""" & sFolder & """,""" & sFolder & """)"
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 5).Value = Now
                    oMail.Unread = False
                    oMail.SaveAs (sFolder & "Mail archive\" & oAtch3 & ".msg")
                End If
            Next
        Next
    Next
End Sub

Он прекрасно работает, сохраняет вложения, и заносит в лист архива данные.
Но игнорирует второй аккаунт в аутлуке, а мне необходимо, чтобы макрос выбирал сообщения именно из него.
Аккаунт шаренный.
Я попытался заменить Set oIncoming = oNSpace.GetDefaultFolder(6) на Set oIncoming = oNSpace.GetSharedDefaultFolder("мыло_аккаунта",6), но при этом скрипт просто не определяет папку.
Подскажите, пожалуйста, в чем ошибка?

[Дмитрий Щербаков(The_Prist)]

Можете скачать файл по ссылке: Сохранить вложения из Outlook в указанную папку
Там есть пример определения разных ящиков.
Т.е. по сути Вам надо вместо

Код (vb) Выделить Развернуть

Set oIncoming = oNSpace.GetDefaultFolder(6)
указать конкретную папку:

Код (vb) Выделить Развернуть

oNSpace.Folders("yourmail").Name

[johnyb]

Что-то я не понял, как я это должен применить?

Код (vb) Выделить Развернуть

oNSpace.Folders("yourmail").Name

Заменить прямо в скрипте? или там функция в примере есть? я что-то не нашел, извините за тупняк

[Дмитрий Щербаков(The_Prist)]

как я это должен применить?

м-да...просто я подумал хоть какие-то навыки есть, судя по сообщению
Так же, как пытались применить здесь:

попытался заменить Set oIncoming = oNSpace.GetDefaultFolder(6) на Set oIncoming = oNSpace.GetSharedDefaultFolder("мыло_аккаунта",6)

Просто Вы неверно обращались - к GetSharedDefaultFolder, а надо просто к папке:

Код (vb) Выделить Развернуть

Set oIncoming = oNSpace.Folders("yourmail")