VBA Outlook - автоматический запуск всей электронной почты во входящих?


-1

У меня есть следующий код, который я использую для сохранения вложения электронной почты в папку. Я хочу, чтобы этот vba запускался автоматически каждый раз, когда я открываю внешний вид и проверяю все письма в моем почтовом ящике [email protected] (не входящие в папку по умолчанию).

В настоящий момент, хотя он проверяет только электронное письмо, которое выбрано в активном почтовом ящике. может кто-нибудь, пожалуйста, покажите мне, как я могу редактировать свой код, чтобы заставить его делать то, что мне нужно. спасибо

Public Sub SaveAttachments() 
    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 strDeletedFiles As String 
    Dim withParts As String 
    Dim withoutParts As String 


     ' Get the path to your My Documents folder 
     On Error Resume Next 

     ' Instantiate an Outlook Application object. 
     Set objOL = CreateObject("Outlook.Application") 

     ' Get the collection of selected objects. 
     Set objSelection = objOL.ActiveExplorer.Selection 

    ' The attachment folder needs to exist 
    ' You can change this to another folder name of your choice 


     ' Set the Attachment folder. 
     strFolderPath = "\\UKSH000-FILE06\Purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\" 

     ' Check each selected item for attachments. 

     For Each objMsg In objSelection 

     Set objAttachments = objMsg.Attachments 
     lngCount = objAttachments.Count 
     If lngCount > 0 Then 

     ' Use a count down loop for removing items 
     ' from a collection. Otherwise, the loop counter gets 
     ' confused and only every other item is removed. 

     For i = lngCount To 1 Step -1 

     ' Get the file name. 
     strFile = objAttachments.item(i).FileName 
     If Right(strFile, 3) = "pdf" Then 

     ' Combine with the path to the Temp folder. 
     withParts = strFile 
     withoutParts = Replace(withParts, ".pdf", "") 

     strFile = strFolderPath & withoutParts & "\" & strFile 

     ' Save the attachment as a file. 
     objAttachments.item(i).SaveAsFile strFile 

    End If 
     Next i 
     End If 


     Next 

    ExitSub: 

    Set objAttachments = Nothing 
    Set objMsg = Nothing 
    Set objSelection = Nothing 
    Set objOL = Nothing 
    End Sub 
  0

Вы хотите проверить ** все ** письма или просто все ** новые ** почту? Для новой почты, возможно, подумайте о вызове этой процедуры (с некоторыми изменениями) из события «Application_NewMailEx». Для работы с несколькими почтовыми ящиками установите флажок [this] (http://www.jpsoftwaretech.com/handling-multiple-inboxes/) или используйте Google. Если вы застряли, пересмотрите свой Q. Ответы там готовы быть найдены, и мы можем помочь вам, если вы застряли. 10 окт. 142014-10-10 14:28:32

0

Просто нужно отредактировать некоторые строки. Используйте что-то вроде objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("[email protected]") в папку на том же уровне, что и папка «Входящие». Здесь модифицируют код:

Public Sub SaveAttachments() 
    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 strDeletedFiles As String 
    Dim withParts As String 
    Dim withoutParts As String 


     ' Get the path to your My Documents folder 
     On Error Resume Next 

     ' Instantiate an Outlook Application object. 
     Set objOL = CreateObject("Outlook.Application") 

     ' Get the collection of selected objects. 
     'Set objSelection = objOL.ActiveExplorer.Selection 
     'Istead set this to the selected objects you just need to set to your email folder 

     'This is for a inbox same level folder 
     Set objSelection = objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("[email protected]") 

     'This is for a folder inside the inbox folder 
     'Set objSelection = objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("[email protected]") 

    ' The attachment folder needs to exist 
    ' You can change this to another folder name of your choice 


     ' Set the Attachment folder. 
     strFolderPath = "\\UKSH000-FILE06\Purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\" 

     ' Check each selected item for attachments. 

     For Each objMsg In objSelection 

     Set objAttachments = objMsg.Attachments 
     lngCount = objAttachments.Count 
     If lngCount > 0 Then 

     ' Use a count down loop for removing items 
     ' from a collection. Otherwise, the loop counter gets 
     ' confused and only every other item is removed. 

     For i = lngCount To 1 Step -1 

     ' Get the file name. 
     strFile = objAttachments.item(i).FileName 
     If Right(strFile, 3) = "pdf" Then 

     ' Combine with the path to the Temp folder. 
     withParts = strFile 
     withoutParts = Replace(withParts, ".pdf", "") 

     strFile = strFolderPath & withoutParts & "\" & strFile 

     ' Save the attachment as a file. 
     objAttachments.item(i).SaveAsFile strFile 

    End If 
     Next i 
     End If 


     Next 

    ExitSub: 

    Set objAttachments = Nothing 
    Set objMsg = Nothing 
    Set objSelection = Nothing 
    Set objOL = Nothing 
    End Sub 

Чтобы запустить его автоматически, когда прогноз начинает просто положить его на «ThisOutlookSession» в объектах папку и назовите его «Sub Application_Startup()». Не забудьте включить макросы раньше.

  0

привет, я пробовал это, но когда я пытаюсь запустить его, ничего не происходит, и мои вложения не будут сохранены. 10 окт. 142014-10-10 15:11:34

  0

Вы хотите только sabe вложения PDF? Где находится ваша папка? Внутри папки «Входящие» или на том же уровне? Какое имя вашей папки? С этим я могу отредактировать его лучше. 10 окт. 142014-10-10 15:34:34

  0

@RomeurForte это мой путь к папке, но папка, в которой сохраняется файл pdf, будет именем вложения pdf strFolderPath = "\\ UKSH000-FILE06 \ Purchasing \ New_Supplier_Set_Ups _ & _ Audits \ ATTACHMENTS \" 13 окт. 142014-10-13 10:15:53

  0

Какая у вас почтовая папка, где электронные письма расположены? 13 окт. 142014-10-13 18:00:55