Здравствуйте, многоуважаемые гуру!
Не могу решить проблему с обработкой и архивацией писем с доп. аккаунта в аутлуке, через макрос эксель.
Есть такой код:
Он прекрасно работает, сохраняет вложения, и заносит в лист архива данные.
Но игнорирует второй аккаунт в аутлуке, а мне необходимо, чтобы макрос выбирал сообщения именно из него.
Аккаунт шаренный.
Я попытался заменить Set oIncoming = oNSpace.GetDefaultFolder(6) на Set oIncoming = oNSpace.GetSharedDefaultFolder("мыло_аккаунта",6), но при этом скрипт просто не определяет папку.
Подскажите, пожалуйста, в чем ошибка?
Не могу решить проблему с обработкой и архивацией писем с доп. аккаунта в аутлуке, через макрос эксель.
Есть такой код:
| Код |
|---|
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), но при этом скрипт просто не определяет папку.
Подскажите, пожалуйста, в чем ошибка?
Изменено: - 26.10.2020 09:44:23
