使用Excel VBA指向备用.pst收件箱的非默认文件夹

Question

I cannot find code that works, and that is entirely operated out of Excel VBA to point to an inbox that is not the default inbox in Outlook. Imagine you have a second inbox, with an alternative email address for special emails. It seems like;

Set Inbox = Ns.GetDefaultFolder(olFolderInbox) is the natural location to alter to the appropriate code. Some suggestions involved using parent.folder but that does not appear to function. Suggestions?

Assume alternative inbox has the name "New Orders"

I have tried using Set Inbox = Ns.GetDefaultFolder(6).Parent.Folders("New Orders")

Answer 1

That won't do. What you're basically doing is looking for another folder with the same hierarchy as the Inbox folder (on the same account or email) but not another folder in another account.

...with an alternative email address for special emails...

Try using this for the above case (I used 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

First, you can try running the For Loop to check if you really have 2 accounts. Once verified, you can go ahead and play around with it. HTH.

Answer 2

HTH, thanks for your suggestions. I have tried to incorporate this into my code. Unfortunatly I am left in the same position. I am not receiving a blank file in my destination folder of 4kb with the proper naming convention

here is what I have so far..perhaps you can see my error in context.

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