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

Posted 2023-02-19

【中文标题】如何指向替代 .pst 的文件夹？

【英文标题】：How to point to a folder of an alternative .pst?

【发布时间】：2019-12-13 12:06:41

【问题描述】：

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

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

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

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

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

【问题讨论】：

Get reference to additional Inbox的可能重复

【参考方案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。

【参考方案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 = "[e-mail]" 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("[e-mail]")
    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