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

EN

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

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