使用Excel VBA指向備用.pst收件箱的非默認文件夾

Question

我找不到有效的代碼，並且該代碼完全在Excel VBA中無法運行，以指向不是Outlook中默認收件箱的收件箱。 假設您有第二個收件箱，其中還有一個用於特殊電子郵件的備用電子郵件地址。 這好像是;

Set Inbox = Ns.GetDefaultFolder(olFolderInbox)是更改為適當代碼的自然位置。 一些建議涉及使用parent.folder，但似乎沒有作用。 建議？

假設替代收件箱的名稱為“新訂單”

我曾嘗試使用Set Inbox = Ns.GetDefaultFolder(6).Parent.Folders("New Orders")

Answer 1

那不會。 您基本上要做的是尋找與“ Inbox文件夾具有相同層次結構的另一個文件夾（在同一帳戶或電子郵件上），而不是在另一個帳戶中的另一個文件夾。

...以及用於特殊電子郵件的備用電子郵件地址...

嘗試將其用於上述情況（我使用了Early Binding）：

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