Форум программистов, компьютерный форум, киберфорум
MS Office Outlook
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.89/9: Рейтинг темы: голосов - 9, средняя оценка - 4.89
0 / 0 / 0
Регистрация: 09.10.2016
Сообщений: 1
1

Автоматическая отправка вложенных файлов из писем в аутлуке в опредёлённую папку

08.11.2016, 23:22. Просмотров 1821. Ответов 2
Метки нет (Все метки)

Здравствуйте.
Мне приходят письма через аутлук. Письмо называется допустим Дубравная 46. В письме вложено фото. Я это фото в ручную отправляю в соответствующую папку. Но папка названа номером. В файле эксель есть списки где указано какому адресу какой номер соответствует. То есть там написано в четвёртом столбце список улиц, в пятом номера домов, в первом номера уникальные по которым и названы папки.
Мне нужно что бы вложенные файлы автоматически отправлялись в свою папку.
Нашёл такой макрос (но не могу его для себя приспособить):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim objAttachments As Outlook.Attachment
Dim saveFolder As String
Dim openMsg As MailItem
 
dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd")
saveFolder = "C:\Test"
If Dir(saveFolder, vbDirectory) = "" Then
  MkDir saveFolder
End If
For t = 1 To Len(itm.Subject)
  s = Mid(itm.Subject, t, 1)
  If Not LCase(s) Like "[?/\|*<>:]" Then
    sSubject = sSubject & s
  End If
Next t
 
For Each objAtt In itm.Attachments
saveFolderFull = saveFolder & sSubject
If Dir(saveFolderFull, vbDirectory) = "" Then
  MkDir saveFolderFull
End If
 
'Проверяем наличие файла с таким же именем
j = " "
  For i = 1 To 1000
   If Not Dir(saveFolderFull & "" & dateOfMailItem & j & objAtt.FileName) = "" Then
    j = "_" & i & "_"
   Else
    Exit For
   End If
  Next i
'Конец проверки
objAtt.SaveAsFile saveFolderFull & "" & dateOfMailItem & j & objAtt.FileName
'Из msg файлов достаём вложения и удаляем
If LCase(Right(objAtt.FileName, 4)) = ".msg" Then
   Set openMsg = Application.CreateItemFromTemplate(saveFolderFull & "" & dateOfMailItem & j & objAtt.FileName)
   sSubject2 = ""
   For t = 1 To Len(openMsg.Subject)
    s = Mid(openMsg.Subject, t, 1)
    If Not LCase(s) Like "[?/\|*<>:]" Then
     sSubject2 = sSubject2 & s
    End If
   Next t
   If Dir(saveFolderFull & "" & sSubject2, vbDirectory) = "" Then
     MkDir saveFolderFull & "" & sSubject2
   End If
   'Сохраняем вложения из msg-файла
   For Each objAttachments In openMsg.Attachments
     objAttachments.SaveAsFile saveFolderFull & "" & sSubject2 & "" & dateOfMailItem & objAttachments.FileName
     Next
  openMsg.Close olDiscard
  Kill saveFolderFull & "" & dateOfMailItem & j & objAtt.FileName 'Удаляем файл msg-файла
End If
Set objAtt = Nothing
Next
End Sub
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
08.11.2016, 23:22
Ответы с готовыми решениями:

Автоматическая отправка писем из Outlook
Во входящие поступает унифицированное письмо, содержащее в теле письма тлф номер и @. Задача:...

Автоматическая отправка писем с формы.
Привет всем. Помогите, плз. Есть следующая проблемма. Необходимо сделать так, чтобы при создании...

Возможна ли автоматическая отправка писем?
Собственно не так давно первый раз увидел Lotus Notes. Да и то на работе. Поэтому заранее прошу...

Автоматическая ежедневная отправка писем из Outlook
Товарищи, помогите, пожалуйста в вопросе: каждый день на один и тот же адрес нужно отправлять...

2
0 / 0 / 0
Регистрация: 18.01.2015
Сообщений: 14
02.06.2017, 14:42 2
Вот рабочий макрос:
Visual Basic
1
2
3
4
5
6
Sub save_a(myItem As Outlook.MailItem)
Dim att_count As Integer
For att_count = 1 To myItem.Attachments.Count
myItem.Attachments.Item(att_count).SaveAsFile ("C:\Письма\1" & myItem.Attachments.Item(att_count).FileName)
Next
End Sub
Но макрос будет работать только совместно с Правилом !
И нужно будет написать столько макросов сколько адресатов Вы предполагаете и путь указать для каждого номера. Затем создать столько же Правил...
0
0 / 0 / 0
Регистрация: 18.01.2015
Сообщений: 14
06.06.2017, 12:55 3
Цитата Сообщение от ErlanB Посмотреть сообщение
Последний раз редактировалось Fairuza; Сегодня в 14:45.
Да вроде всё также осталось ))))))))))))
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
06.06.2017, 12:55

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

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

Outlook - сохранение и разархивирование всех вложенных файлов из непрочитанных писем
Ситуация следующая.. Мне нужно сохранять вложения из всех новых писем в папку с текущей датой и...

Копирование в папку, исходя из вложенных файлов
Добрый день. Есть файлы для отправки BV100_ZNOXXXXXXXX_XXXXXXXXXXXX_NNNNNN.txt , где X - постоянные...

Что делать с ошибкой отображения писем в аутлуке?
Microsoft Outlook 2007 Появляется сообщение ,что PST-файл поврежден, и нет ни одного письма в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.