Outlook VBA Сохранить вложение сохраняет неправильное вложение при получении электронной почты - PullRequest
Новая
       46

Outlook VBA Сохранить вложение сохраняет неправильное вложение при получении электронной почты

0 голосов
/ 06 декабря 2018

Я создал правила Outlook, чтобы сохранить вложение и переместить его в папку «Удаленные».Правило работает, когда я выделяю поступившее письмо в папке «Входящие», а затем перемещаю его в папку «Удаленные».Однако, когда пришло новое сообщение, оно сохраняет вложения из другого сообщения в папке «Входящие» и не перемещает сообщение в папку «Удаленные».

Правило Outlook: 

    Apply this rule after the message arrives
from Sender
 and with Gift Card in the subject
 and on this computer only
run Project1.SaveAttachments


Public Sub SaveAttachments(MItem As Outlook.Mailitem)
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.Mailitem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim objNamespace As Outlook.NameSpace
    Dim objDestFolder As Outlook.MAPIFolder
    
On Error Resume Next

Set objOL = CreateObject("Outlook.Application")

Set objSelection = objOL.ActiveExplorer.Selection

strFolderpath = "Y:\"

For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    strDeletedFiles = ""

    If lngCount > 0 Then

        For i = lngCount To 1 Step -1

            strFile = objAttachments.Item(i).FileName
            strFile = strFolderpath & strFile
            objAttachments.Item(i).SaveAsFile strFile
        Next i
        Set objNamespace = objOL.GetNamespace("MAPI")
        Set objDestFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)
                    
        objMsg.Move objDestFolder

    End If
    
Next
 
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Set objNamespace = Nothing
Set objDestFolder = Nothing

End Sub

1 Ответ

0 голосов
/ 06 декабря 2018

Согласно моему тесту, вы можете сохранить вложение электронной почты и удалить его, используя следующий код: 

Sub SaveAutoAttach()

Dim object_attachment As Outlook.attachment

Dim saveFolder As String
Dim oOutlook As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim unRead, m As Object, att As Object
Dim some As String, other As String

Const olFolderInbox = 6

'~~> Get Outlook instance
Set oOutlook = GetObject(, "Outlook.application")
Set oOlns = oOutlook.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

'~~> Check if there are any actual unread emails
Set unRead = oOlInb.Items.Restrict("[UnRead] = True")

If unRead.Count = 0 Then
    MsgBox "NO Unread Email In Inbox"
Else

    some = ""
    other = ""
    saveFolder = "D:\"
    For Each m In unRead
        If m.Attachments.Count > 0 Then
            For Each object_attachment In m.Attachments
            ' Criteria to save .doc files only
                If InStr(object_attachment.DisplayName, ".doc") Then
                    object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
                End If
             Next
        End If
        m.Delete
    Next m
End Sub

Для получения дополнительной информации, пожалуйста, перейдите по этой ссылке:

АвтоЗагрузить приложение электронной почты Outlook - код в VBA от Topbullets.com

...