1. Набираем команду codeby webinar. Набираем команду для организации и проведения вебинаров. Подробнее ...

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление
  3. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление

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

Тема в разделе "Visual Basic", создана пользователем vsl, 7 янв 2008.

  1. vsl

    vsl Гость

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

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

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

    Код:
    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
     
Загрузка...

Поделиться этой страницей