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