Question

我需要通过Excel VBA从特定的Outlook帐户从收件箱文件夹中下载附件。

如果我只有一个帐户，并且我从该帐户的收件箱文件夹中下载附件，我的代码现在可以正常工作，但是如何更改它以下载附件，比如说从帐户“ foo@gmail.com”和“收件箱”文件夹中呢？

Function readMails()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace

Dim olItem As Outlook.MailItem
Dim i As Integer
Dim b As Integer
Dim olInbox  As Outlook.MAPIFolder
Dim olFolder As Outlook.MAPIFolder
Dim lngCol As Long
Dim oMsg As Outlook.MailItem
Dim mainWB As Workbook
Dim keyword
Dim Path
Dim Atmt
Dim f_random
Dim Filename

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

Set mainWB = ActiveWorkbook

Set olInbox = olNamespace.GetDefaultFolder(Outlook.olFolderInbox)
Dim oItems As Outlook.Items
Set oItems = olInbox.Items

Path = mainWB.Sheets("Main").Range("J5").Value
keyword = mainWB.Sheets("Main").Range("J4").Value

For i = 1 To oItems.Count
    If TypeName(oItems.Item(i)) = "MailItem" Then
        Set oMsg = oItems.Item(i)

         If InStr(1, oMsg.Subject, keyword, vbTextCompare) > 0 Then
                For Each Atmt In oMsg.Attachments
                    Filename = Path & Atmt.Filename
                    Atmt.SaveAsFile Filename
                    FnWait (1)
                Next Atmt
         End If

    End If
Next

End Function

Answer 1

配置文件定义一个或多个电子邮件帐户，并且每个电子邮件帐户都与特定类型的服务器相关联。对于Exchange服务器，存储可以位于服务器上，Exchange公用文件夹中或本地个人文件夹文件（.pst）或脱机文件夹文件（.ost）中。对于POP3，IMAP或HTTP电子邮件服务器，存储是.pst文件。

您可以使用Stores和Store对象枚举当前会话中所有商店上的所有文件夹和搜索文件夹。由于要在商店中获取根文件夹或搜索文件夹需要打开商店，而打开商店会增加性能，因此您可以在决定进行操作之前先检查Store.IsOpen属性。

下面的代码行检索交货存储的收件箱文件夹：

Set olInbox = olNamespace.GetDefaultFolder(Outlook.olFolderInbox)

相反，您需要遍历配置文件中的所有商店，并获取每个商店的“收件箱”文件夹：

Dim colStores As Outlook.Stores 
Dim oStore As Outlook.Store 

Set colStores = olNamespace.Stores
For Each oStore In colStores 
  Set olInbox = oStore.GetDefaultFolder(Outlook.olFolderInbox)
  ' do whatever you need here
Next

例如：

 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

使用Excel从特定帐户下载Outlook附件

1 个答案: