Написание скриптов в Outlook - [1] :: Прикладное программирование

Есть два вопроса по макросам для Outlook (у меня 2003):
1. Написал макрос для сохранения вложений из выделенных писем в заданную папку. Но! Среди прогнанных писем попались такие в которых в теле есть рисунки, и они тоже считаются вложениями, хотя в outlooke как вложения и не отображаются. В большинстве случаев их можно отфильтровать по Attachments.Item(i).Position. Однако иногда и у них занчение параметра равно 0 (как и у действительно вложений) и тогда отделить их от вложений не получается. Но сам outlook как-то понимает что это не вложения. Есть ли надежный способ чтобы выделить действительно вложения для сохранения? Мой код:
Код:

Const DefFolder = "C:\"

Sub SaveAttachments()
Dim objApp As Outlook.Application
Dim objItem As Object
Dim objSelection As Outlook.Selection
Dim objMail As MailItem
Dim AttFolder As String

Set objApp = CreateObject("Outlook.Application")
Set objSelection = objApp.ActiveExplorer.Selection

AttFolder = Trim(InputBox("Задайте имя папки", "Сохранение вложений"))

If AttFolder <> "" Then AttFolder = AttFolder + "\"

If MsgBox("Сохранить все вложения в папку " + DefFolder + AttFolder + "? Все файлы с такими именами в этой папке будут перезаписаны!", vbQuestion + vbOKCancel) = vbOK Then
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(DefFolder + AttFolder) Then
fs.createfolder (DefFolder + AttFolder)
End If

For Each objItem In objSelection
If objItem.Class = olMail Then
Set objMail = objItem
For i = 1 To objMail.Attachments.Count
If objMail.Attachments.Item(i).Position = 0 Then
objMail.Attachments.Item(i).SaveAsFile DefFolder + AttFolder + objMail.Attachments.Item(i).DisplayName
End If
Next
End If
Next
End If
End Sub

2. Как сделать чтобы при перемещении макросом писем из одной папки в другую время и дата получения письма не менялись на текущие? В моем случае происходит именно так. Мой код:
Код:

Private Sub NewItems_ItemAdd(ByVal Item As Object)
Dim NewFolder As Outlook.MAPIFolder
Dim NewName As String
Dim NewMail As MailItem
Dim idx As Integer
' Check to make sure it is an Outlook mail message, otherwise
' subsequent code will probably fail depending on what type
' of item it is.
If TypeName(Item) = "MailItem" Then
Set NewMail = Item
NewName = Format(NewMailTime, "yyyy-mm")
On Error Resume Next
MainFolder.Folders.Add NewName
On Error GoTo 0
For idx = 1 To MainFolder.Folders.Count
If MainFolder.Folders.Item(idx).Name = NewName Then
Set NewFolder = MainFolder.Folders.Item(idx)
End If
Next
NewMail.Move NewFolder
End If
End Sub

Модерирует : ShIvADeSt
Версия для печати • Подписаться • Добавить в закладки
Страницы: 1 2 3 4