Выполните действие с выбранным письмом, которое переместит это письмо в папку в соответствующем банке / аккаунте / почтовом ящике.

Question

У меня есть код, чтобы переместить почту в папку, созданную с именем экспедитора. Но у меня есть 4 разных банка / аккаунта почты (один с .fr, второй с .com ..), и по умолчанию все папки создаются (и письма перемещаются) в первой и основной учетной записи. , поэтому мои письма смешаны.

Фактически используется бит кода:

Установить мой Root = Session.GetDefaultFolder (olFolderInbox)

Я попытался посмотреть в обозревателе объектов в интерфейсе макросов Outlook Outlook VBA, но я только что нашел Getdefaultfolder (в пространстве имен или классе хранилища), который Я не совсем понимаю. Я не нашел "сеанса", и, кажется, ничто не компилируется эффективно, за исключением фактического бита кода ..

У вас есть идеи, чтобы мой код работал в том же "почтовом банке" выбранная почта? Спасибо вам огромное!

Overflowly, Keyo

Answer 1

С .Parent работать вверх от известного элемента к папке, в которой он находится, к папке выше этого до почтового ящика.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant

Sub selectionParent()

Dim currItem As Object  ' not mailitem

Dim curFolder As Folder
Dim myRoot As Folder

' select a mailitem in an inbox or subfolder of an inbox
Set currItem = ActiveExplorer.Selection(1)

If currItem.Class = olMail Then

    Debug.Print
    Debug.Print currItem.Subject
    
    Set curFolder = currItem.Parent
    
    ' safest to compare text after LCase or UCase
    Do Until LCase(curFolder.name) = LCase("inbox")
        Debug.Print " curFolder.name: " & curFolder.name
        Set curFolder = curFolder.Parent
    Loop
    
    ' This is the inbox folder associated with the selected item
    Set myRoot = curFolder
    Debug.Print " myRoot: " & myRoot
    Debug.Print " The mailbox is myRoot.Parent: " & myRoot.Parent

Else

    Debug.Print
    Debug.Print "** not a mailtem **"
    
End If

End Sub

На практике Session эквивалентно GetNamespace("MAPI") . Сохраняет несколько строк кода.

Любая из этих трех версий дает тот же результат.

Private Sub session_LineSaver_NamespaceMapi()

    Dim inboxFldr As Folder
    
    Debug.Print
    Debug.Print "Session"
    Set inboxFldr = Session.GetDefaultFolder(olFolderInbox)
    Debug.Print " inboxFldr: " & inboxFldr
    Debug.Print " inboxFldr.Parent: " & inboxFldr.Parent
    
    
    Debug.Print
    Debug.Print "GetNamespace - not best practice, harder to see errors"
    Set inboxFldr = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Debug.Print " inboxFldr: " & inboxFldr
    Debug.Print " inboxFldr.Parent: " & inboxFldr.Parent
    
    
    Debug.Print
    Debug.Print "GetNamespace - create a separate object for the namespace"
    Dim nS As Namespace             ' extra line
    Set nS = GetNamespace("MAPI")   ' extra line
    
    Set inboxFldr = nS.GetDefaultFolder(olFolderInbox)
    Debug.Print " inboxFldr: " & inboxFldr
    Debug.Print " inboxFldr.Parent: " & inboxFldr.Parent

End Sub

Answer 2

Кажется, вам нужно переместить элемент Outlook в папку в том же магазине. Метод Store.GetDefaultFolder возвращает объект Folder, который представляет папку по умолчанию в хранилище и имеет тип, указанный аргументом FolderType. Этот метод аналогичен методу GetDefaultFolder объекта NameSpace. Разница в том, что этот метод получает папку по умолчанию в хранилище доставки, которая связана с учетной записью, тогда как NameSpace.GetDefaultFolder возвращает папку по умолчанию в хранилище по умолчанию для текущего профиля.

Sub EnumerateFoldersInStores() 
 Dim colStores As Outlook.Stores 
 Dim oStore As Outlook.Store 
 Dim oRoot As Outlook.Folder 
 
 On Error Resume Next 
 Set colStores = Application.Session.Stores 
 For Each oStore In colStores 
 Set oRoot = oStore.GetRootFolder 
 Debug.Print (oRoot.FolderPath) 
 EnumerateFolders oRoot 
 Next 
End Sub 
 
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder) 
 Dim folders As Outlook.folders 
 Dim Folder As Outlook.Folder 
 Dim foldercount As Integer 
 
 On Error Resume Next 
 Set folders = oFolder.folders 
 foldercount = folders.Count 
 'Check if there are any folders below oFolder 
 If foldercount Then 
 For Each Folder In folders 
 Debug.Print (Folder.FolderPath) 
 EnumerateFolders Folder 
 Next 
 End If 
End Sub

Итак, вы нужно найти экземпляр магазина, который соответствует экспедитору (электронная почта), и переместить туда товар.