VBA во втором почтовом ящике (общая учетная запись)
Я полный новичок в VBA. Итак, это, вероятно, очень простой вопрос, но я просто не могу заставить его работать даже со всеми другими очень полезными потоками.
Я использую следующий код VBA, чтобы переместить электронное письмо в определенную подпапку папки «Входящие», как только оно будет помечено тегом «Счет».
Private WithEvents objInboxFolder As Outlook.Folder
Private WithEvents objInboxItems As Outlook.Items
'Process inbox mails
Private Sub Application_Startup()
Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInboxFolder.Items
End Sub
'Occurs when changing item
Private Sub objInboxItems_ItemChange(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objTargetFolder As Outlook.Folder
If TypeOf Item Is MailItem Then
Set objMail = Item
'Move mails based on color category
If InStr(objMail.Categories, "Invoice") > 0 Then
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Invoices").Folders("Uploaded")
objMail.Move objTargetFolder
End If
End If
End Sub
Это прекрасно работает. Единственная проблема заключается в том, что у меня есть 2 разных почтовых ящика/учетных записи в Outlook: мой личный адрес электронной почты, а также [email protected] (используется несколькими людьми). Как мне изменить код, чтобы адресовать входящие сообщения бухгалтерского учета вместо моего личного стандартного почтового ящика?
Большое спасибо!
Отвечает ли это на ваш вопрос? Получить ссылку на дополнительный почтовый ящик
Ответы 1
Вы можете использовать метод Store.GetDefaultFolder, который возвращает объект Folder, который представляет папку по умолчанию в магазине и имеет тип, указанный аргументом FolderType. Этот метод аналогичен методу GetDefaultFolder объекта NameSpace. Разница в том, что этот метод получает папку по умолчанию в хранилище доставки, связанную с учетной записью, тогда как NameSpace.GetDefaultFolder возвращает папку по умолчанию в хранилище по умолчанию для текущего профиля.
Итак, вы можете перебрать магазины в профиле Outlook и найти нужный. Например, следующий код показывает, как рекурсивно перебирать все хранилища и папки в Outlook:
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
Вы можете проверить свойство Store.DisplayName, чтобы найти необходимое хранилище в профиле, а затем получить требуемую папку входящих сообщений определенного хранилища в Outlook.