如何在第二个收件箱(共享帐户)上运行代码?

Question

一旦给邮件打上"发票"标签，我就会把它移到收件箱的一个特定子文件夹中。

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

我在Outlook中有两个邮箱/帐户。我的个人电子邮件地址以及[e-mail](多人使用)。

如何处理会计收件箱?

Answer 1

您可以使用Store。GetDefaultFolder方法，该方法返回一个Folder对象，该对象表示存储中的默认文件夹，并且是由FolderType参数指定的类型。此方法类似于NameSpace对象的GetDefaultFolder方法。不同之处在于，此方法获取与帐户关联的交付存储中的默认文件夹，而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

你可以去商店看看。属性来查找配置文件中所需的存储，然后在Outlook中获得特定存储的所需收件箱文件夹。