• 🔥 Бесплатный курс от Академии Кодебай: «Анализ защищенности веб-приложений»

    🛡 Научитесь находить и использовать уязвимости веб-приложений.
    🧠 Изучите SQLi, XSS, CSRF, IDOR и другие типовые атаки на практике.
    🧪 Погрузитесь в реальные лаборатории и взломайте свой первый сайт!
    🚀 Подходит новичкам — никаких сложных предварительных знаний не требуется.

    Доступ открыт прямо сейчас Записаться бесплатно

Vba и Outlook, прошу помощи

  • Автор темы Автор темы vsl
  • Дата начала Дата начала
V

vsl

Друзья, добрый день! Окажите посильную помощь в решении некоторой, для многих очевидной, задачки). Условия такие: перебираем все папки в аутлуке до тех пор, пока нужную не найдём. А как найдём, так в ней непрочтённые письма перебирать будем (на предмет сохраниния вложенных в них файлов). Код (сырой, скопированный из сети и переработанный малость) ниже.

ЗАТЫРКА в следующем: как только нащёл нужную папку, как обратиться к находящимся к ним объёктам типа писем (последняя процедура)? СИЛОВ больше моих НЕТ!

Прошу поспособствовать!

Код:
Option Explicit
Const BalFolderName As String = "Отчетность"
Const TmpFolderName As String = "C:\Temp\Bal.tmp\"

'Dim mailItems As Items
'Dim mailmsg As MailItem
'Dim Sender$, SenderEmail$
'Dim i As Integer


Sub StartSorter()
'Узнать список папок Outlook
Dim allFolders As Folders
Dim intLevel As Integer  ' номер уровня

intLevel = 0
Set allFolders = Application.GetNamespace("MAPI").Folders
Call FoldersViewRecurse(allFolders, intLevel, "MAPI")
End Sub


Sub FoldersViewRecurse(allFolders As Folders, intLevel As Integer, strName As String)
Dim i As Integer, FolderName As String
Dim newFolders As Folders
' Вывод информации о папках данного узла иерархической структуры
' Debug.Print "Уровень = "; intLevel; " Узел = "; strName$; Tab(45); " Вложенных папок = "; allFolders.Count

If allFolders.Count > 0 Then ' есть вложенные папки
For i = 1 To allFolders.Count ' обзор вложенных папок
FolderName$ = allFolders.Item(i).Name
Set newFolders = allFolders.Item(i).Folders
' рекурсивное обращение к самой себе:

If FolderName$ = BalFolderName Then Call LettersView(newFolders, i)

Call FoldersViewRecurse(newFolders, intLevel + 1, FolderName)
Next
End If
End Sub

Sub LettersView(currentFolder As Folders, iii As Integer)

Dim mailItems As Items
Dim mailmsg As MailItem

Set mailmsg = currentFolder.Item(iii).Items

'
'		objFolder = Application.Outlook.MAPIFolder.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
Debug.Print (objFolder.Name)
End Sub
 
Мы в соцсетях:

Взломай свой первый сервер и прокачай скилл — Начни игру на HackerLab