Outlook 2003. Правило вида перебрось в папку "Имя папки" и выполни сценарий.
Код сценария:
Public Sub SaveAttachments(objitem As MailItem)
On Error GoTo err_h
'Sub SaveAttachments()
Dim objApp As Outlook.Application
'Dim objitem As Object
Dim objSelection As Outlook.Selection
Dim objMail As MailItem
Dim AttFolder, TP, dte As String
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
Set objApp = CreateObject("Outlook.Application")
Set objSelection = objApp.ActiveExplorer.Selection
'AttFolder = Trim(InputBox("Задайте имя папки", "Сохранение вложений"))
AttFolder = "Хранилище"
If AttFolder <> "" Then AttFolder = AttFolder + "\"
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(DefFolder + AttFolder) Then
fs.createfolder (DefFolder + AttFolder)
End If
'set objitem=objapp
If objitem.Class = olMail Then
Set objMail = objitem
For i = 1 To objMail.Attachments.Count
If objMail.Attachments.Item(i).Position = 0 Then
dte = Replace(Mid(objMail.ConversationTopic, 19, 11), ":", "_")
j = InStr(objMail.ConversationTopic, "ТП:")
TP = Mid(objMail.ConversationTopic, j + 3, Len(objMail.ConversationTopic) - j - 3)
TP = Replace(TP, "Головной офис, ", "")
TP = Replace(TP, "Головной офис", "")
TP = Trim(TP)
If Not fs.folderexists(DefFolder + AttFolder & TP & "\") Then
fs.createfolder (DefFolder + AttFolder & TP & "\")
End If
objMail.Attachments.Item(i).SaveAsFile DefFolder + AttFolder & TP & "\" & "db.zip"
If fs.fileexists(DefFolder + AttFolder & TP & "\" & "db.mdb") Then
fs.deletefile (DefFolder + AttFolder & TP & "\" & "db.mdb")
End If
oApp.NameSpace(DefFolder + AttFolder & TP & "\").CopyHere oApp.NameSpace(DefFolder + AttFolder & TP & "\" & "db.zip").Items
fs.deletefile (DefFolder + AttFolder & TP & "\" & "db.zip")
Call addnote(TP, Now())
End If
Next
End If
' TP = Mid(objMail.Attachments.Item(i).DisplayName, 19, 10)
' fs.MoveFile DefFolder & AttFolder & "db", DefFolder & AttFolder & "db_"
Exit Sub
err_h:
End Sub
Проблема в том, что письма в папку падают, а вот сценарий даже не запускается(проверял установкой брейка на начале). 3 дня назад все работало ОК.
Переход на другой почтовый клиент/обработка в резидентном софте/установка доп софта(не самописного)/подобное не предлагать.
Заранее спасибо за содержательные ответы.
Примечание:
Перя и перебрасываю в папку стандартными средствами, но вот распаковать аттач уже не могу.Сейчас(тьфу-тьфу) уже 3-й день сценарий запускается при новой почте, но как будет потом((((
Примечание:
Ничего личного, но папка - это не папка в Outlook, а папка на жестком диске, а уж этого(вместе с запуском распаковщика) Outlook штатно делать не умеет. Redemption и прочее - без шансов -политика компании.
RPI.su - самая большая русскоязычная база вопросов и ответов. Наш проект был реализован как продолжение популярного сервиса otvety.google.ru, который был закрыт и удален 30 апреля 2015 года. Мы решили воскресить полезный сервис Ответы Гугл, чтобы любой человек смог публично узнать ответ на свой вопрос у интернет сообщества.
Все вопросы, добавленные на сайт ответов Google, мы скопировали и сохранили здесь. Имена старых пользователей также отображены в том виде, в котором они существовали ранее. Только нужно заново пройти регистрацию, чтобы иметь возможность задавать вопросы, или отвечать другим.
Чтобы связаться с нами по любому вопросу О САЙТЕ (реклама, сотрудничество, отзыв о сервисе), пишите на почту [email protected]. Только все общие вопросы размещайте на сайте, на них ответ по почте не предоставляется.