Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сохранение вложений из нескольких писем (Outlook), batch attachments saving
 
День добрый. Использую вот такой код для сохранения вложений из нескольких выделенных писем сразу (нужные рассылки и всё такое).
Скрытый текст

Из-за того, что Application.FileDialog не хочет работать в Outlook, приходится вызывать диалоговое окно Word (он быстрее грузится у меня, чем Excel :) )
Но диалоговое окно выбора папки сохранения появляется у меня в фоновом режиме, т.е. "за окном" Outlook.
Как его заставить появляться впереди? что-то туплю. Причем желательно не в режиме system.modal, т.к. иногда нужно проверить, правильно ли выбран каталог, при помощи проводника.
F1 творит чудеса
 
Я пользуюсь shell
Код
Sub test()
Dim Ws As Object, Fld As Object
On Error Resume Next
Set Ws = CreateObject("Shell.application")
Set Fld = Ws.browseforfolder(0, "Выбор папки", 0, "c:\")
If Not Err.Number = 91 Then MsgBox Fld.self.Path
Set Ws = Nothing : Set Fld = Nothing
End Sub
 
Спасибо за наводку, так сильно быстрее и правильнее!!!
Только заменил "c:" на "ssfDRIVES" - привычнее и нет ограничения сверху.
Итоговый код
F1 творит чудеса
 
Этот параметр можно вообще не использовать
Код
Set Fld = Ws.browseforfolder(0, "Select path to save attachments:", 0)
 
Друзья, нашел вот такой код для этой же цели
Код
Dim myobj As Object
Dim att As Attachment
For Each myobj In Application.ActiveExplorer.Selection
If myobj.Class = olMail Then
For Each att In myobj.Attachments
att.SaveAsFile "D:\Attachments\" + att.FileName
Next
End If
Next
Тоже хорошо и быстро работает, но...

Можете подсказать как модифицировать этот код?
Много писем от одного отправителя. Вложение с одним и тем же называнием. Но тема письма всегда разная.
Как можно этот скрипт изменить так что бы он сохранял вложения, переименовывая его по называнию темы письма?

Очень выручите от обезьяньего труда. Спасибо!
 
Код
att.SaveAsFile "D:\Attachments" + myobj.Subject & ".тут расширение файла"


всякие проверки на правильность написания имени файла и его расширения на Вашей совести.
 
Возможно ли через макрос открыть папку, выбранную для сохранения файлов?
 
Добрый день
Максим Зеленский, спасибо за код
Вложения выгружает, но если у вложений одинаковое имя, то сохраняется только одно, остальные нет.

Подскажите пожалуйста, как изменить код чтобы в имени выгружаемых вложений перед расширением (".xls" или другие) стояла дата присланного письма:

Код
Sub SaveAttmnts()
Dim myobj As Object
Dim att As Attachment
Dim sPath As String
Dim Ws As Object, Fld As Object
On Error Resume Next
Set Ws = CreateObject("Shell.application")
Set Fld = Ws.BrowseForFolder(0, "Select path to save attachments:", 0, "ssfDRIVES")
If Not Err.Number = 91 Then
    sPath = Fld.self.Path
Else
    Exit Sub
End If
Set Ws = Nothing: Set Fld = Nothing
For Each myobj In Application.ActiveExplorer.Selection
    If myobj.Class = olMail Then
    For Each att In myobj.Attachments
        att.SaveAsFile sPath & "\" & att.FileName
    Next
    End If
Next
MsgBox "Attachments saved to " & sPath, vbOKOnly + vbInformation + vbSystemModal
End Sub
Изменено: viktor.petryuk - 28 Фев 2018 13:05:31
 
Попробуйте пока так:
Код
Sub SaveAttmnts()
  Dim a As Variant
  Dim myobj As Object
  Dim att As Attachment
  Static sPath As String
  Dim Ws As Object, Fld As Object
  Dim i As Long, j As Long
  On Error Resume Next
  Set Ws = CreateObject("Shell.application")
  Set Fld = Ws.BrowseForFolder(0, "Select path to save attachments:", 0, sPath & "\")
  If Not Err.number = 91 Then
    sPath = Fld.self.PATH
    If Len(Fld.self.PATH) = 0 Then Exit Sub
  Else
    Exit Sub
  End If
  Set Ws = Nothing: Set Fld = Nothing
  For Each myobj In Application.ActiveExplorer.Selection
    If myobj.Class = olMail Then
      j = 0
      For Each att In myobj.Attachments
        j = j + 1
        a = Split(att.FileName, ".")
        i = UBound(a)
        If i > 0 Then i = i - 1
        a(i) = a(i) & "_" & Format(myobj.ReceivedTime, "yyddmm-hhmmss") & Format(j, "-00")
        att.SaveAsFile sPath & "\" & Join(a, ".")
      Next
    End If
  Next
  MsgBox "Attachments saved to " & sPath, vbOKOnly + vbInformation + vbSystemModal
End Sub
Изменено: ZVI - 1 Мар 2018 08:47:47
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
ZVI, СПАСИБО ОГРОМНОЕ!!!
:)  Все работает!
 
Цитата
Максим Зеленский написал:
Итоговый код
Здравствуйте. А можно ли сделать так, чтобы после сохранения вложений письмам присваивалась цветовая категория(зеленая)?
 
Правила, пункт об отображаемом имени. Уберите цифры слева от имени
Страницы: 1
Читают тему (гостей: 1)
Наверх