Поиск вложений Outlook ограничен днем ​​недели и сохраняйте вложения - PullRequest
Новая
       42

Поиск вложений Outlook ограничен днем ​​недели и сохраняйте вложения

0 голосов
/ 29 октября 2019

Я хочу выполнить поиск по папкам Outlook, начиная с предыдущего дня недели, поэтому исключаю выходные, и если файл не существует, выведите «этот отчет не был отправлен дата ».

И для сохранения файла как: при условии, что заголовок заголовка содержит не более двух текстов. И что файл будет сохранен с двумя найденными буквами в теле заголовка.

Я хочу сделать это для шести разных случаев. 

Sub SaveOutlookAttachments()
Dim ol As Outlook.Application 
Dim ns As Outlook.Namespace  
Dim ofolder As Outlook.folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI") 
Set ofolder = ns.Folders(1).Folders("Inbox") 

For Each i In ofolder.Items

    If i.Class = olMail Then

        Set mi = i                  'This ensure that were looking at an email object rather than any potential item

        'I need to find a way to create a case or an if statement that would reference 2 keywords in the title of the email subject in order to download and save the file with those keywords + date at the end.
        'The logic is to use the title to distinguish between 4 regional reports for 1 Partner and 3 reports for 3 different partners. These would save files in their names associated with the title of the email. Eg: Comp.ABC Regional Reports 20/10/2019. I should also only search for previous days only within weekdays/working days - Mondays to Fridays.


        Debug.Print mi.SenderName, mi.ReceivedTime, mi.Attachments.Count

        For Each at In mi.Attachments

        at.SaveAsFile "C:\Users\rootname\OneDrive\Desktop\VBATesting" & at.FileName & Format(mi.ReceivedTime, "dd-mm-yyyy")   'Put in a valid folder location to store attachements

        Next at

    End If

Next i

End Sub

1 Ответ

1 голос
/ 02 ноября 2019

Вот код, который сначала проверяет значение ReceivedTime в MailItem для условия Date (вы можете пойти дальше и исключить выходные). Затем он проверяет объект MailItem для ключевых слов из коллекции colKeywords, которую можно редактировать и добавлять. Это также должно приблизить вас к тому, что вы хотите сделать. Я также переименовал переменные для ясности: 

Dim objOutlook As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objItem As Object
Dim objMailItem As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim colKeywords As New Collection
Dim sKeyword As String
Dim iCounter As Integer
Dim iBackdate As Integer

Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.Folders(1).Folders("Inbox")

' Add your Keywords here
colKeywords.Add "keyword1"
colKeywords.Add "keyword2"

For Each objItem In objFolder.Items

    ' Check Item Class
    If objItem.Class = Outlook.olMail Then

        ' Set as Mail Item
        Set objMailItem = objItem

        With objMailItem

            Select Case Weekday(Now)
                Case 7 ' Saturday: add extra day
                    iBackdate = 3
                Case 1, 2, 3 ' Sunday through Tuesday: add extra 2 days
                    iBackdate = 4
                Case Else ' Other days
                    iBackdate = 2
            End Select

            ' Check date
            If .ReceivedTime > DateAdd("d", -iBackdate, Now) Then

                ' Loop through all keywords
                For iCounter = 1 To colKeywords.Count

                    ' Get keyword
                    sKeyword = colKeywords.Item(iCounter)

                    ' Check if keyword exists
                    If InStr(.Subject, sKeyword) > 0 Then

                        ' Save Attachments
                        For Each objAttachment In .Attachments

                            objAttachment.SaveAsFile "C:\Users\rootname\OneDrive\Desktop\VBATesting" & objAttachment.FileName & Format(.ReceivedTime, "dd-mm-yyyy")   'Put in a valid folder location to store attachements

                        Next

                    End If

                Next

            End If

        End With

    End If

Next
...