Использование VBA в Excel для ссылки на почтовый ящик Outlook, отличный от Inbox - PullRequest
Новая
       10

Использование VBA в Excel для ссылки на почтовый ящик Outlook, отличный от Inbox

0 голосов
/ 12 октября 2018

Редактировать: Я на самом деле понял это!Я заменил строку 

Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

на 

Dim NS As Outlook.Namespace
Dim objOwner As Outlook.Recipient

Set NS = outlookApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("sharedmailbox@companyname.com")
    Objowner.Resolve

If objOwner.Resolved Then
   MsgBox objOwner.Name 'You can comment this out if you want

Set outlookInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

Исходное сообщение: У меня есть этот код, который я запускаю в Excel VBA, который ищет конкретного отправителя и вложениеимя в моем почтовом ящике Outlook по умолчанию.Затем он сохраняет вложение в указанной папке на моем рабочем столе, переименовывая файл с датой получения электронного письма.

Однако я хочу отредактировать код, чтобы он выполнял поиск не в папке «Входящие» по умолчанию,но в другом общем почтовом ящике в моем Outlook.Предположим, что адрес электронной почты, на который этот общий почтовый ящик получает электронные письма, - sharedmailbox@companyname.com.Это, очевидно, отдельно от моего личного адреса электронной почты.

Как я могу отредактировать этот код, чтобы он выполнял поиск в этом почтовом ящике, а не в моем собственном почтовом ящике? 

Option Explicit

Sub GetLatestReport()

'Set a reference to Outlook's object library (Visual Basic >> Tools >> References >> check/select Microsoft Outlook Object Library)

Dim outlookApp              As Outlook.Application
Dim outlookInbox            As Outlook.MAPIFolder
Dim outlookRestrictItems    As Outlook.Items
Dim outlookLatestItem       As Outlook.MailItem
Dim outlookAttachment       As Outlook.Attachment
Dim attachmentFound         As Boolean

Const saveToFolder          As String = "C:\Users\jalanger\Desktop\Demo" 'change the save to folder accordingly
Const senderName            As String = "Langer, Jaclyn" 'change the sender name accordingly
Const attachmentName        As String = "Report on ACBS LC for AMLS (Chandran Panicker)" 'change the attachment name accordingly

Dim SavePath                As String


'Create an instance of Outlook
Set outlookApp = New Outlook.Application

'Get the inbox from Outlook
Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

'Filter the items from the inbox based on the sender
Set outlookRestrictItems = outlookInbox.Items.Restrict("[SenderName] = '" & senderName & "'")

'Check whether any items were found
If outlookRestrictItems.Count = 0 Then
    MsgBox "No items were found from " & senderName & "!", vbExclamation
    Exit Sub
End If

'Sort the filtered items by received time and in descending order
outlookRestrictItems.Sort Property:="[ReceivedTime]", Descending:=True

'Get the latest item from the filtered and sorted items
Set outlookLatestItem = outlookRestrictItems(1)

'Make sure that file extension at the end of this line is correct
SavePath = saveToFolder & "\" & attachmentName & " " & CStr(Format(outlookLatestItem.ReceivedTime, "Long Date")) & ".xls"
MsgBox SavePath

'Loop through each attachment from the latest item until specified file is found
attachmentFound = False
For Each outlookAttachment In outlookLatestItem.Attachments
    If Left(UCase(outlookAttachment.FileName), Len(attachmentName)) = UCase(attachmentName) Then
        outlookAttachment.SaveAsFile SavePath 'saveToFolder & "\" & outlookAttachment.DisplayName
        attachmentFound = True
        Exit For
    End If
Next outlookAttachment

If attachmentFound Then
    MsgBox "The attachment was found and saved to '" & saveToFolder & "'!", vbInformation
Else
    MsgBox "No attachment was found!", vbExclamation
End If

Workbooks.Open FileName:=SavePath

End Sub

Ответы [ 2 ]

0 голосов
/ 19 октября 2018

Вы можете использовать свойство DeliveryStore учетной записи, чтобы получить входящие.Например: 

Sub ResolveName()
Dim ns As NameSpace
Set ns = Application.Session
Dim acc As Account
Dim f As Folder

For Each acc In ns.accounts
    MsgBox acc.UserName
    If acc = "text@outlook.com" Then
    Set f = acc.DeliveryStore.GetDefaultFolder(olFolderInbox)
    MsgBox f.Items.count

End If
Next
End Sub

Вы можете фильтровать, используя acc = "text@outlook.com" или свойство acc.UserName.

0 голосов
/ 12 октября 2018

Если у вас есть вторая настройка учетной записи в Outlook (например, sharedmailbox@companyname.com), вы можете заменить эту строку: 

Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

на эту: 

Set outlookInbox = outlookApp.GetNamespace("MAPI").Accounts.Item(2).Session.GetDefaultFolder(olFolderInbox)

Это будет использоватьВходящие второго аккаунта.

...