Есть задача - почти каждый день, от одного и того же человека, с одинаковой темой и названием файла приходит сообщение с вложенным файлом. Нужно как то автоматизировать это, чтобы при приходе такого сообщения файл автоматически переписывал старый файл. Outlook 2003
» Написание скриптов в Outlook
ищется скрипт, чтобы при запуске оного сразу ставились все пометки в письмо, которые приходится ручками делать в этом окошке
DYm00nДвумя постами выше вашего Gremlin19 поместил скрипт, который сохраняет аттачмент на диск. Воспользуйтесь им, модифицировав его в соответствии со своими реалиями и желаниями.
vlary
если бы знал VBA тогда бы и сам скрипт написал, а т.к. не знаю, поэтому и задаю тут вопрос
если бы знал VBA тогда бы и сам скрипт написал, а т.к. не знаю, поэтому и задаю тут вопрос
Уважаемые форумчане, подскажите, пожалуйста, текст макроса для перемещения писем, отправленных определённым адресатам, из папки "Отправленные" в заданные мной папки. Что-то типа упорядочивания. Желательно, чтобы макрос выполнялся автоматически после отправки сообщений.
Sagirus
А средствами самого Outlook никак?
Сервис->Правила и оповещения.
А средствами самого Outlook никак?
Сервис->Правила и оповещения.
А средствами MS Outlook при настройке правил сообщения из папки "Отправленные" не перемещаются, они копируются!!! Правило по перемещению сообщений работает только для папки "Входящие". Мне необходимо ПЕРЕМЕЩАТЬ сообщения после отправки из папки "Отправленные" в назначенную мной папку.
Прошу помочь. Заранее благодарю!
Добавлено:
Fill747
А средствами MS Outlook при настройке правил сообщения из папки "Отправленные" не перемещаются, они копируются!!! Правило по перемещению сообщений работает только для папки "Входящие". Мне необходимо ПЕРЕМЕЩАТЬ сообщения после отправки из папки "Отправленные" в назначенную мной папку.
Прошу помочь. Заранее благодарю!
Прошу помочь. Заранее благодарю!
Добавлено:
Fill747
А средствами MS Outlook при настройке правил сообщения из папки "Отправленные" не перемещаются, они копируются!!! Правило по перемещению сообщений работает только для папки "Входящие". Мне необходимо ПЕРЕМЕЩАТЬ сообщения после отправки из папки "Отправленные" в назначенную мной папку.
Прошу помочь. Заранее благодарю!
Сголасен с предыдущим оратором: перемещение штатными средствами - невозможно. Эта проблема где только не обсуждается, а грамотных решений - нет. Microsoft уже вполне мог отреагировать на запросы масс потребителей и устранить эту проблему. Скорее всего они имеют какие-то принципиальные возражения на эту тему, раз не сделали, однако, странно.
Как в Outlook отвечать на текст в HTML? (в экспрессе есть такая галочка - овечать в формате исходных, в МС - такого нет)
Прежде чем задать вопрос -перерыл все мыслимые и не мыслимые ресурсы. Предлагают использовать какой-то скрипт, а какой???
По идее надо делать следующее:
1) Если произошло Событие "ответить"
2) читаем заголовок сообщения
3) Если заголовок НТМЛ - иди в конец
Если заголовок текст, заменить на "НТМЛ"
4) конец
Теперь бы все это на ВБА или ВБС
Прежде чем задать вопрос -перерыл все мыслимые и не мыслимые ресурсы. Предлагают использовать какой-то скрипт, а какой???
По идее надо делать следующее:
1) Если произошло Событие "ответить"
2) читаем заголовок сообщения
3) Если заголовок НТМЛ - иди в конец
Если заголовок текст, заменить на "НТМЛ"
4) конец
Теперь бы все это на ВБА или ВБС
Sagirus
Цитата:
Так создайте 2 правила. 1-е на копирование. 2-е на очищение.
Цитата:
А средствами MS Outlook при настройке правил сообщения из папки "Отправленные" не перемещаются, они копируются!!!
Так создайте 2 правила. 1-е на копирование. 2-е на очищение.
Подскажите, нужен скрипт, который создавал бы новую учетную запись. Не могу найти готовый, сам вряд ли осилю. Может кто-то поделится уже готовым. Буду очень признателен
чтобы не мучиться попробуй сначала средствами самого аутлука, потом поищи макросы на V
Тут хоть мучайся, хоть не мучайся, все равно не получается.
Я дополнительно пытаюсь написать скрипт для закрытия аутлука. Но он почему-то не работает.
On Resume Next
Set Outlook = GetObject(, «Outlook.Application»)
If Err = 0 Then
Outlook.Quit()
End If
Не подскажите, в чем может быть ошибка
Я дополнительно пытаюсь написать скрипт для закрытия аутлука. Но он почему-то не работает.
On Resume Next
Set Outlook = GetObject(, «Outlook.Application»)
If Err = 0 Then
Outlook.Quit()
End If
Не подскажите, в чем может быть ошибка
Немного исправил и все заработало
On Error Resume Next
Set Outlook = GetObject(, «Outlook.Application»)
If Err = 0 Then
Outlook.Quit()
End If
On Error Resume Next
Set Outlook = GetObject(, «Outlook.Application»)
If Err = 0 Then
Outlook.Quit()
End If
может кто заморачивался уже с конвертом в трее... требуется помощь светлых голов!
задача: добиться появления конверта в трее в outlook 2007 при сортировке писем по папкам.
общими усилиями в теме на ixbt создали скрипт, который, работает, но с существенной оговоркой.
он раскидывать почту по папкам (и конверт появляется в трее), только после того, как будет вызвано окно VB (нажатием Alt-F11). т.е. открыл окно, закрыл – и тогда скрипт нормально работает.
если же это окно [после запуска outlook] не открыть – то никакой реакции не будет. почта приходит, падает во "входящие" (для работы скрипта галки в правилах должны быть сняты), скрипт не срабатывает. если же нажать Alt-F11 в любой момент, то следующие письма уже будут обработаны скриптом.
вопрос: как заставить срабатывать скрипт за запуске outlook'a?
спасибо
задача: добиться появления конверта в трее в outlook 2007 при сортировке писем по папкам.
общими усилиями в теме на ixbt создали скрипт, который, работает, но с существенной оговоркой.
он раскидывать почту по папкам (и конверт появляется в трее), только после того, как будет вызвано окно VB (нажатием Alt-F11). т.е. открыл окно, закрыл – и тогда скрипт нормально работает.
если же это окно [после запуска outlook] не открыть – то никакой реакции не будет. почта приходит, падает во "входящие" (для работы скрипта галки в правилах должны быть сняты), скрипт не срабатывает. если же нажать Alt-F11 в любой момент, то следующие письма уже будут обработаны скриптом.
вопрос: как заставить срабатывать скрипт за запуске outlook'a?
спасибо
Всем привет !
Может кто подскажет такую вещь, не могу никак найти в инете... кто сталкивался ???
ОЧЕНЬ НАДО
Вот программно создаю письмо и нужно чтобы это письмо было подписано ЦИФРОВОЙ подписью
(т.е. установлен сертификат X509 подписи. Не путать с простой подписью внизу сообщения).
Чтоб было понятнее: Вкладка в интерфейсе Параметры -> окно Параметры сообщения -> Бзопасность -> Параметры безопасности -> окно Свойства безопасности -> шилдик Добавить в сообщение цифровую подпись.
Вот программно установить этот шилдик и нужно
все письма подписывать не надо (это к тому, что можно в настройках проставить и все будут такие),
ан нет только определенные.
Может кто подскажет такую вещь, не могу никак найти в инете... кто сталкивался ???
ОЧЕНЬ НАДО
Вот программно создаю письмо и нужно чтобы это письмо было подписано ЦИФРОВОЙ подписью
(т.е. установлен сертификат X509 подписи. Не путать с простой подписью внизу сообщения).
Чтоб было понятнее: Вкладка в интерфейсе Параметры -> окно Параметры сообщения -> Бзопасность -> Параметры безопасности -> окно Свойства безопасности -> шилдик Добавить в сообщение цифровую подпись.
Вот программно установить этот шилдик и нужно
все письма подписывать не надо (это к тому, что можно в настройках проставить и все будут такие),
ан нет только определенные.
Всем спасибо - нашел. Sorry, что не написал сразу ;( , не было времени.
Вот решение довольно простое:
Dim msg As Outlook.MailItem
msg.GetInspector.CommandBars.FindControl(msoControlButton, 719, "", True).Execute
msg.GetInspector.CommandBars.FindControl(msoControlButton, 718, "", True).Execute
т.е. по ID кнопочки (msoControlButton) просто делаем нажатие ...
Вот собственно и всё.
Проверено и работает на Outlook 2007, думаю и в др. тоже будет работать
Вот решение довольно простое:
Dim msg As Outlook.MailItem
msg.GetInspector.CommandBars.FindControl(msoControlButton, 719, "", True).Execute
msg.GetInspector.CommandBars.FindControl(msoControlButton, 718, "", True).Execute
т.е. по ID кнопочки (msoControlButton) просто делаем нажатие ...
Вот собственно и всё.
Проверено и работает на Outlook 2007, думаю и в др. тоже будет работать
Sagirus
Вполне возможно сделать перемещение отправленных сообщений - пишем правило на перемещение после отправки, и отключаем сохранение отправленных писем в настройках почты. Иначе не нашел как такое можно сделать
Вполне возможно сделать перемещение отправленных сообщений - пишем правило на перемещение после отправки, и отключаем сохранение отправленных писем в настройках почты. Иначе не нашел как такое можно сделать
Помогите пожалуйста,
Требуется в Outlook 2010 сделать так чтобы при отправке сообщение к нему в начало добавилась следующая часть:
From: От кого (e-mail)
To: Кому (e-mail)
Copy:
Sent: Monday, July 30, 2012 18:42
Subject: "тема сообщения"
Требуется в Outlook 2010 сделать так чтобы при отправке сообщение к нему в начало добавилась следующая часть:
From: От кого (e-mail)
To: Кому (e-mail)
Copy:
Sent: Monday, July 30, 2012 18:42
Subject: "тема сообщения"
Написал скрипт для Outlook на vba, теперь хочу его копировать на все компьютеры с помощью vbs. Может кто подскажет как это можно сделать
----------------------------
Option Explicit
Dim wsh
Set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run("OUTLOOK.EXE")
Set wsh = Nothing
----------------------------
Застрял вот на этом месте запускаю outlook с помощью vbs, а как вызвать vba и импортировать текстовый файл не получается
Заранее благодарен
----------------------------
Option Explicit
Dim wsh
Set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run("OUTLOOK.EXE")
Set wsh = Nothing
----------------------------
Застрял вот на этом месте запускаю outlook с помощью vbs, а как вызвать vba и импортировать текстовый файл не получается
Заранее благодарен
xxxKOSCHEIxxx
Нажать F1, в поиске набрать "создание подписи".
хотя это в конце будет ставится, чтобы в начале было во всех сообщениях нужно это настраивать на сервере почты возможно. У себя я не настраивал, изначально было что в каждом письме есть "от","кому" и т.п. и в любом аутлуке после 2003
RaX
outlook vba из вне работает через объект "outlook.application"
Код:
Set olApp = CreateObject("outlook.application")
Set oNS = olApp.GetNamespace("MAPI")
Set oFldr = oNS.Folders.Item("Microsoft Outlook Personal Folders File (.pst)")
.....
...
Нажать F1, в поиске набрать "создание подписи".
хотя это в конце будет ставится, чтобы в начале было во всех сообщениях нужно это настраивать на сервере почты возможно. У себя я не настраивал, изначально было что в каждом письме есть "от","кому" и т.п. и в любом аутлуке после 2003
RaX
outlook vba из вне работает через объект "outlook.application"
Код:
Set olApp = CreateObject("outlook.application")
Set oNS = olApp.GetNamespace("MAPI")
Set oFldr = oNS.Folders.Item("Microsoft Outlook Personal Folders File (.pst)")
.....
...
Здравствуйте,
кто нибудь решал задачу с добавлением в "избранное" общкй папки Exchange. А то они спрятаны от пользователя пока их в избранное не кинешь.
может у кого есть скрипт или подскажете куда посмотреть .
Спасибо.
кто нибудь решал задачу с добавлением в "избранное" общкй папки Exchange. А то они спрятаны от пользователя пока их в избранное не кинешь.
может у кого есть скрипт или подскажете куда посмотреть .
Спасибо.
Привет всем
Написал скрипт на VBA под Outlook 2007 для разбора входящих писем. Скрипт сохраняет письма в папки на сетевом диске и сортирует по папкам в самом Outlook.
Текст скрипта поместил в ThisOtlookSession
Собственно скрипт это обработчик события Application_NewMail() и ряд вспомогательных подпрограмм вызывываемых из Application_NewMail()
Проблема заключается в том, что скрипт отрабатывает однократно при первом возникновении события Application_NewMail() - обработка проходит, письмо сохраняется в папку на диске, из папки "входящие" письмо перемещается в нужную папку в самом Outlook. То есть как бы всё нормально.
Но когда подобное письмо приходит второй раз - обработка не отрабатывает.
[more=код]
Код:
Private Sub Application_NewMail()
GlobalVarsInit
Dim olns As NameSpace
Dim InboxFolder As MAPIFolder
Dim DstFolder As MAPIFolder
Dim MailItems As Items
Dim MyClause As String
Dim Item As MailItem
Dim ItemDate As Date
Dim DateStamp As String
Dim FileName As String
Dim LogFile As Object
Set LogFile = FSO.OpenTextFile(FSAPath & LogFileName, 8, True, 0)
Set olns = Application.GetNamespace("MAPI")
Set InboxFolder = olns.GetDefaultFolder(olFolderInbox)
Set MailItems = InboxFolder.Items
MyClause = "[Unread] = True"
Set Item = MailItems.Find(MyClause)
Do While Not (Item Is Nothing)
If Item.SenderName = "EUR_AMR_SVC_365CHG Figaro" Then
Select Case Item.Subject
Case "Protocol of employee exiting"
ItemDate = Item.SentOn
DateStamp = GetDateStamp(ItemDate)
FileName = Item.Subject & "_" & DateStamp
If Hour(ItemDate) >= 12 Then
FileName = FileName & "_2" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & EmployeeFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Employes")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName)
Case "Figaro modules downloading"
Dim AnalyseRetValue As Integer
DateStamp = GetDateStamp(Item.SentOn)
FileName = Item.Attachments.Item(1).FileName
Item.Attachments.Item(1).SaveAsFile FSAPath & FileName
AnalyseRetValue = ModulesProtocolAnalyse(FileName)
FileName = Item.Subject & "_" & DateStamp
If AnalyseRetValue = -1 Then
FileName = FileName & "_Error" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & MirrorFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Modules")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName & ";" & AnalyseRetValue)
If AnalyseRetValue > 0 Then
ForwardModulesProtocol Item
End If
Case "Figaro-Oracle contracts transfering"
FigaroOracleLettersProcessing Item, "Contracts\", "Contracts", LogFile, olns
Case "Figaro-Oracle invoices transfering"
FigaroOracleLettersProcessing Item, "Invoices\", "Invoices", LogFile, olns
Case "Figaro-Oracle export sales transfering"
FigaroOracleLettersProcessing Item, "Export sales\", "Export_Sales", LogFile, olns
End Select
End If
Set Item = MailItems.FindNext
Loop
End Sub
Написал скрипт на VBA под Outlook 2007 для разбора входящих писем. Скрипт сохраняет письма в папки на сетевом диске и сортирует по папкам в самом Outlook.
Текст скрипта поместил в ThisOtlookSession
Собственно скрипт это обработчик события Application_NewMail() и ряд вспомогательных подпрограмм вызывываемых из Application_NewMail()
Проблема заключается в том, что скрипт отрабатывает однократно при первом возникновении события Application_NewMail() - обработка проходит, письмо сохраняется в папку на диске, из папки "входящие" письмо перемещается в нужную папку в самом Outlook. То есть как бы всё нормально.
Но когда подобное письмо приходит второй раз - обработка не отрабатывает.
[more=код]
Код:
Private Sub Application_NewMail()
GlobalVarsInit
Dim olns As NameSpace
Dim InboxFolder As MAPIFolder
Dim DstFolder As MAPIFolder
Dim MailItems As Items
Dim MyClause As String
Dim Item As MailItem
Dim ItemDate As Date
Dim DateStamp As String
Dim FileName As String
Dim LogFile As Object
Set LogFile = FSO.OpenTextFile(FSAPath & LogFileName, 8, True, 0)
Set olns = Application.GetNamespace("MAPI")
Set InboxFolder = olns.GetDefaultFolder(olFolderInbox)
Set MailItems = InboxFolder.Items
MyClause = "[Unread] = True"
Set Item = MailItems.Find(MyClause)
Do While Not (Item Is Nothing)
If Item.SenderName = "EUR_AMR_SVC_365CHG Figaro" Then
Select Case Item.Subject
Case "Protocol of employee exiting"
ItemDate = Item.SentOn
DateStamp = GetDateStamp(ItemDate)
FileName = Item.Subject & "_" & DateStamp
If Hour(ItemDate) >= 12 Then
FileName = FileName & "_2" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & EmployeeFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Employes")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName)
Case "Figaro modules downloading"
Dim AnalyseRetValue As Integer
DateStamp = GetDateStamp(Item.SentOn)
FileName = Item.Attachments.Item(1).FileName
Item.Attachments.Item(1).SaveAsFile FSAPath & FileName
AnalyseRetValue = ModulesProtocolAnalyse(FileName)
FileName = Item.Subject & "_" & DateStamp
If AnalyseRetValue = -1 Then
FileName = FileName & "_Error" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & MirrorFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Modules")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName & ";" & AnalyseRetValue)
If AnalyseRetValue > 0 Then
ForwardModulesProtocol Item
End If
Case "Figaro-Oracle contracts transfering"
FigaroOracleLettersProcessing Item, "Contracts\", "Contracts", LogFile, olns
Case "Figaro-Oracle invoices transfering"
FigaroOracleLettersProcessing Item, "Invoices\", "Invoices", LogFile, olns
Case "Figaro-Oracle export sales transfering"
FigaroOracleLettersProcessing Item, "Export sales\", "Export_Sales", LogFile, olns
End Select
End If
Set Item = MailItems.FindNext
Loop
End Sub
Возникшую проблему решил, путём использования другого события. Вместо Application_NewMail() я переделал код под событие Application_NewMailEx(ByVal EntryIDCollection As String).
[more=код]
Код:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
GlobalVarsInit
Dim olns As NameSpace
Dim InboxFolder As MAPIFolder
Dim DstFolder As MAPIFolder
Dim MailItems As Items
Dim MyClause As String
Dim Item As Object
Dim ItemDate As Date
Dim DateStamp As String
Dim FileName As String
Dim LogFile As Object
Dim i As Integer
Set LogFile = FSO.OpenTextFile(FSAPath & LogFileName, 8, True, 0)
Set olns = Application.GetNamespace("MAPI")
Dim varEntryIDs
varEntryIDs = Split(EntryIDCollection, ",")
i = -1
Do While True
lp_10:
If i >= UBound(varEntryIDs) Then
Exit Do
End If
i = i + 1
If varEntryIDs(i) = "" Then
Exit Do
End If
Set Item = Application.Session.GetItemFromID(varEntryIDs(i))
If Not TypeName(Item) = "MailItem" Then
GoTo lp_10
End If
If Item.SenderName = "EUR_AMR_SVC_365CHG" Then
Select Case Item.Subject
Case "Protocol of employee exiting"
ItemDate = Item.SentOn
DateStamp = GetDateStamp(ItemDate)
FileName = Item.Subject & "_" & DateStamp
If Hour(ItemDate) >= 12 Then
FileName = FileName & "_2" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & EmployeeFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Employes")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName)
Case "Figaro modules downloading"
Dim AnalyseRetValue As Integer
DateStamp = GetDateStamp(Item.SentOn)
FileName = Item.Attachments.Item(1).FileName
Item.Attachments.Item(1).SaveAsFile FSAPath & FileName
AnalyseRetValue = ModulesProtocolAnalyse(FileName)
FileName = Item.Subject & "_" & DateStamp
If AnalyseRetValue = -1 Then
FileName = FileName & "_Error" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & MirrorFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Modules")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName & ";" & AnalyseRetValue)
If AnalyseRetValue > 0 Then
ForwardModulesProtocol Item
End If
Case "Figaro-Oracle contracts transfering"
FigaroOracleLettersProcessing Item, "Contracts\", "Contracts", LogFile, olns
Case "Figaro-Oracle invoices transfering"
FigaroOracleLettersProcessing Item, "Invoices\", "Invoices", LogFile, olns
Case "Figaro-Oracle export sales transfering"
FigaroOracleLettersProcessing Item, "Export sales\", "Export_Sales", LogFile, olns
End Select
End If
Loop
LogFile.Close
End Sub
[more=код]
Код:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
GlobalVarsInit
Dim olns As NameSpace
Dim InboxFolder As MAPIFolder
Dim DstFolder As MAPIFolder
Dim MailItems As Items
Dim MyClause As String
Dim Item As Object
Dim ItemDate As Date
Dim DateStamp As String
Dim FileName As String
Dim LogFile As Object
Dim i As Integer
Set LogFile = FSO.OpenTextFile(FSAPath & LogFileName, 8, True, 0)
Set olns = Application.GetNamespace("MAPI")
Dim varEntryIDs
varEntryIDs = Split(EntryIDCollection, ",")
i = -1
Do While True
lp_10:
If i >= UBound(varEntryIDs) Then
Exit Do
End If
i = i + 1
If varEntryIDs(i) = "" Then
Exit Do
End If
Set Item = Application.Session.GetItemFromID(varEntryIDs(i))
If Not TypeName(Item) = "MailItem" Then
GoTo lp_10
End If
If Item.SenderName = "EUR_AMR_SVC_365CHG" Then
Select Case Item.Subject
Case "Protocol of employee exiting"
ItemDate = Item.SentOn
DateStamp = GetDateStamp(ItemDate)
FileName = Item.Subject & "_" & DateStamp
If Hour(ItemDate) >= 12 Then
FileName = FileName & "_2" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & EmployeeFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Employes")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName)
Case "Figaro modules downloading"
Dim AnalyseRetValue As Integer
DateStamp = GetDateStamp(Item.SentOn)
FileName = Item.Attachments.Item(1).FileName
Item.Attachments.Item(1).SaveAsFile FSAPath & FileName
AnalyseRetValue = ModulesProtocolAnalyse(FileName)
FileName = Item.Subject & "_" & DateStamp
If AnalyseRetValue = -1 Then
FileName = FileName & "_Error" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & MirrorFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Modules")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName & ";" & AnalyseRetValue)
If AnalyseRetValue > 0 Then
ForwardModulesProtocol Item
End If
Case "Figaro-Oracle contracts transfering"
FigaroOracleLettersProcessing Item, "Contracts\", "Contracts", LogFile, olns
Case "Figaro-Oracle invoices transfering"
FigaroOracleLettersProcessing Item, "Invoices\", "Invoices", LogFile, olns
Case "Figaro-Oracle export sales transfering"
FigaroOracleLettersProcessing Item, "Export sales\", "Export_Sales", LogFile, olns
End Select
End If
Loop
LogFile.Close
End Sub
Мальчишки и девчонки, подскажите можно ли настроить Outlook 2007, чтобы он забирал почту с сервера каждый день ровно в 18:00, Outlook постоянно весит в трее. "Автоматически доставлять каждые" (0-1440мин.) - это меня не устраивает, ибо комп выключается, а при включении настройка - "Автоматически доставлять каждые" сбивается по времени. Может как скрипт можно написать? Спасибо!
Здравствуйте, есть скрипт для сохранения вложений из письма, запускается после срабатывания правила, с этим проблем нет. хотелось бы усовершенствовать функционал скрипта (знаний в кодировании увы минимальны). практически в каждом письме есть два файла с расширением .txt, один из которых в названии всегда имеет слово image, в идеале при сохранении хотелось бы получить переименование этих файлов в 1.txt и image.txt, при положительном решении вопроса могу финансово отблагодарить (адекватные суммы конечно)
Dugin,
Звучит несложно...
скрипт показать можете?
Звучит несложно...
скрипт показать можете?
KDPoid, да скрипт сейчас каждое письмо сохраняет в отдельную папку присваивая имя которые было в теме письма+время создания письма
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd_hhnnss")
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
If Dir("c:\Work\" & dateOfMailItem & "_" & sSubject, vbDirectory) = "" Then
MkDir "c:\Work\" & dateOfMailItem & "_" & sSubject
End If
saveFolder = "c:\Work\& dateOfMailItem & "_" & sSubject & "\"
k = 0
For Each objAtt In itm.Attachments
ext = Mid(objAtt.FileName, Len(objAtt.FileName) - InStr(1, StrReverse(objAtt.FileName), ".") + 1, Len(objAtt.FileName))
j = " "
k = k + 1
For i = 1 To 1000
If Not Dir(saveFolder & Format(Now, "yyyy.mm.dd") & "_" & k & "_" & j & objAtt.FileName & ext) = "" Then
j = "_" & i & "_"
Else
Exit For
End If
Next i
objAtt.SaveAsFile saveFolder & j & objAtt.FileName & ext
Set objAtt = Nothing
Next
End Sub
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd_hhnnss")
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
If Dir("c:\Work\" & dateOfMailItem & "_" & sSubject, vbDirectory) = "" Then
MkDir "c:\Work\" & dateOfMailItem & "_" & sSubject
End If
saveFolder = "c:\Work\& dateOfMailItem & "_" & sSubject & "\"
k = 0
For Each objAtt In itm.Attachments
ext = Mid(objAtt.FileName, Len(objAtt.FileName) - InStr(1, StrReverse(objAtt.FileName), ".") + 1, Len(objAtt.FileName))
j = " "
k = k + 1
For i = 1 To 1000
If Not Dir(saveFolder & Format(Now, "yyyy.mm.dd") & "_" & k & "_" & j & objAtt.FileName & ext) = "" Then
j = "_" & i & "_"
Else
Exit For
End If
Next i
objAtt.SaveAsFile saveFolder & j & objAtt.FileName & ext
Set objAtt = Nothing
Next
End Sub
Странно, кажется тут:
Код: saveFolder = "c:\Work\& dateOfMailItem & "_" & sSubject & "\"
Код: saveFolder = "c:\Work\& dateOfMailItem & "_" & sSubject & "\"
Спасибо буду пробовать
Предыдущая тема: SystemV семафоры
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.