vba & outlook, прошу помощи

[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

[Teslenko_EA]

Здравствуйте vsl.
В Вашем случае скорее всего лучше обращаться к семейству подобным образом:

Код: Выделить всё

Dim MyObject, MyCollection
For Each MyObject In MyCollection
	If <проверка свойств элемента семейства> Then
		'выполняемое действие
	End If
Next

Евгений.

[vsl]

Здравствуйте vsl.
В Вашем случае скорее всего лучше обращаться к семейству подобным образом:

Код: Выделить всё

Dim MyObject, MyCollection
For Each MyObject In MyCollection
	If <проверка свойств элемента семейства> Then
		'выполняемое действие
	End If
Next

Евгений.

Евгений!
Вопрос несколько в другом! К какому "подсвойству" newFolders и как обратиться, чтобы добраться до писем! : - )

[pilligrim]

Код: Выделить всё

 '(с) Microsoft Help "move"
Sub MoveItems()
	Dim myOlApp As New Outlook.Application
	Dim myNameSpace As Outlook.NameSpace
	Dim myInbox As Outlook.Folder
	Dim myDestFolder As Outlook.Folder
	Dim myItems As Outlook.Items
	Dim myItem As Object
	Set myNameSpace = myOlApp.GetNamespace("MAPI")
	Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
	Set myItems = myInbox.Items
	Set myDestFolder = myInbox.Folders("Personal Mail")
	Set myItem = myItems.Find("[SenderName] = 'Dan Wilson'")
	While TypeName(myItem) <> "Nothing"
		myItem.Move myDestFolder
		Set myItem = myItems.FindNext
	Wend
End Sub

Этот скрипт находит все письма от Dan Wilson и перемещщает их в папку personal mail.
Лень переписываnь. Но уверен что здесь есть ответ на твой вопрос.

[vsl]

Код: Выделить всё

 '(с) Microsoft Help "move"
Sub MoveItems()
	Dim myOlApp As New Outlook.Application
	Dim myNameSpace As Outlook.NameSpace
	Dim myInbox As Outlook.Folder
	Dim myDestFolder As Outlook.Folder
	Dim myItems As Outlook.Items
	Dim myItem As Object
	Set myNameSpace = myOlApp.GetNamespace("MAPI")
	Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
	Set myItems = myInbox.Items
	Set myDestFolder = myInbox.Folders("Personal Mail")
	Set myItem = myItems.Find("[SenderName] = 'Dan Wilson'")
	While TypeName(myItem) <> "Nothing"
		myItem.Move myDestFolder
		Set myItem = myItems.FindNext
	Wend
End Sub

Этот скрипт находит все письма от Dan Wilson и перемещщает их в папку personal mail.
Лень переписываnь. Но уверен что здесь есть ответ на твой вопрос.

Скрипт видел. Мне не письма в известной папке искать, а патку среди PST-шников) А там уж.. Но спасибо за участие