如何指向替代 .pst 的文件夹？

Question

我找不到完全由 Excel VBA 操作的代码，以指向不是 Outlook 中默认收件箱的收件箱。

想象一下第二个收件箱，其中包含特殊电子邮件的备用电子邮件地址。

似乎Set Inbox = Ns.GetDefaultFolder(olFolderInbox) 是在适当代码中更改的自然位置。一些建议涉及使用parent.folder，但这似乎不起作用。

假设备用收件箱的名称为“新订单”

我试过Set Inbox = Ns.GetDefaultFolder(6).Parent.Folders("New Orders")

Answer 1

那不行。您基本上所做的是寻找与Inbox 文件夹（在同一帐户或电子邮件中）具有相同层次结构的另一个文件夹，而不是另一个帐户中的另一个文件夹。

...为特殊电子邮件提供备用电子邮件地址...

尝试在上述情况下使用它（我使用了早期绑定）：

Dim oOL As Outlook.Application
Dim oAcc As Outlook.Account
Dim oStore As Outlook.Store
Dim oFolder As Outlook.Folder

Set oOL = GetObject(, "Outlook.Application")

For Each oAcc In oOL.Session.Accounts
  If oAcc.UserName = "User.Name" Then 
  '// Note: you can use other properties, I used this for demo //
    Set oStore = oAcc.DeliveryStore
    Set oFolder = oStore.GetDefaultFolder(olFolderInbox)
    Set oFolder = oFolder.Parent.Folders("New Oders")
  End If
Next

首先，您可以尝试运行 For Loop 来检查您是否真的有 2 个帐户。验证后，您可以继续使用它。 HTH。

Answer 2

HTH，感谢您的建议。我试图将其合并到我的代码中。不幸的是，我被留在了同一个位置。我没有在我的目标文件夹中收到具有正确命名约定的 4kb 空白文件

这是我目前所拥有的......也许你可以在上下文中看到我的错误。

Option Explicit

Sub Get_IOVFs()


Dim outlookInbox            As Outlook.MAPIFolder
Dim Item                    As Object
Dim outlookAttachment       As Outlook.Attachment
Dim attachmentFound         As Boolean
Dim attachmentName          As String
Const saveToFolder          As String = "C:\Users\Wassej03\Documents\IOVFs_Master"
Const attName               As String = "IOVF "
Dim TimeExt                 As String
Dim SavePath                As String
Dim ExtString               As String
Dim Filename                As String
Dim I                       As Integer

Dim oOL As Outlook.Application
Dim oAcc As Outlook.Account
Dim oStore As Outlook.Store
Dim oFolder As Outlook.Folder

Set oOL = GetObject(, "Outlook.Application")

For Each oAcc In oOL.Session.Accounts
  If oAcc.UserName = "ccIOVF@zoetis.com" Then
  '// Note: you can use other properties, I used this for demo //
    Set oStore = oAcc.DeliveryStore
    Set oFolder = oStore.GetDefaultFolder(olFolderInbox)
    Set oFolder = oFolder.Parent.Folders("Diagnostics Orders")
  End If
Next

TimeExt = format(Now, "dd-mmm-yy h-mm")
attachmentName = attName & TimeExt

'Get the inbox from Outlook
Dim NS As Outlook.Namespace
Dim objOwner As Outlook.Recipient

'Move to the alternative email Inbox
Set NS = oOL.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("cciovf@zoetis.com")
    objOwner.Resolve
Set outlookInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)

'Make sure that file extension at the end of this line is correct
SavePath = saveToFolder & "\" & attachmentName & ".xlsm"

'Loop through each email to save its attachment
I = 0
For Each Item In outlookInbox.Items
    For Each outlookAttachment In Item.Attachments
    If LCase(Right(outlookAttachment.Filename, Len(ExtString))) = LCase(ExtString) Then
                Filename = SavePath
                outlookAttachment.SaveAsFile Filename
                I = I + 1
             End If
        Next outlookAttachment
    Next Item


MsgBox "IOVFs were searched and if found are saved to '" & saveToFolder & "'!", vbInformation

End Sub