Андрей Троценко писал(а):...Можно самому на VisualBasice (даже в Word-е !) склепать програмку...
Нашел свои писаки тысячелетней давности, которые это и делают: сохраняют прикрепления из сообщений в указанной папке, сообщения удаляют. Код работает как в MS Visual Basic-е (в 5 -точно), так и в MS Visual Basice, которым MS Office автоматизирован.
А сейчас я это же делаю GW API GateWay-ем, отдельными аккаунтами и маленькой самопиской на Java.
- Код: Выделить всё
Option Explicit
Dim GWAccount As Object
Private Sub DisplayStatus(Optional status As String = "")
StatusBar = status
End Sub
Public Function GetFolderIDByPath(folder As String)
Dim ParentFolder As Object, slashPos As Integer, FolderToSearch As String
Set ParentFolder = GWAccount.RootFolder
Do Until (Len(folder) = 0)
slashPos = InStr(folder, "/")
If (slashPos = 0) Then
FolderToSearch = folder
folder = ""
Else
FolderToSearch = Left(folder, slashPos - 1)
folder = Mid(folder, slashPos + 1)
End If
Dim ErrNumber As Integer
On Error Resume Next
Set ParentFolder = ParentFolder.Folders.ItemByName(FolderToSearch)
ErrNumber = Err.Number
If (ErrNumber <> 0) Then
Err.Raise (ErrNumber)
End If
Loop
GetFolderIDByPath = ParentFolder.FolderID
Set ParentFolder = Nothing
End Function
Public Sub SaveAttachmentsFromMessages(GWFolderNameToCheck As String, DirForSavedAttachments As String)
Dim GWMessages As Object, GWMessage As Object, GWAttachments As Object, GWAttachment As Object, ErrorSavingAttachment As Boolean
DisplayStatus ("Инициализация GroupWise...")
Set GWAccount = CreateObject("NovellGroupWareSession").Login()
DisplayStatus ("Проверка сообщений...")
Set GWMessages = GWAccount.AllFolders.Item(GetFolderIDByPath(GWFolderNameToCheck)).Messages
For Each GWMessage In GWMessages
DisplayStatus ("Сообщение '" + GWMessage.Subject.PlainText + "'")
ErrorSavingAttachment = False
Set GWAttachments = GWMessage.Attachments
For Each GWAttachment In GWAttachments
Dim AttachmentName As String
AttachmentName = GWAttachment.FileName
DisplayStatus ("Сообщение '" + GWMessage.Subject.PlainText + "', Файл '" + AttachmentName + "'...")
' If GWAttachment.ObjType = egwFile And
If GWAttachment.ObjType = 1 And _
StrComp(AttachmentName, "MIME.822", vbTextCompare) * _
StrComp(AttachmentName, "PART.001", vbTextCompare) * _
StrComp(AttachmentName, "PART.002", vbTextCompare) <> 0 Then
Dim ErrNumber As Integer
On Error Resume Next
GWAttachment.Save (DirForSavedAttachments + AttachmentName)
ErrNumber = Err.Number
On Error GoTo 0
If (ErrNumber <> 0) Then
ErrorSavingAttachment = True
Call MsgBox(Error(Err.Number), vbOKOnly, "Ошибка")
End If
End If
Next
If (ErrorSavingAttachment = False) Then
GWMessage.Delete
End If
Next
DisplayStatus
End Sub
Public Sub Main()
Call SaveAttachmentsFromMessages("Картотека/Тест2", "c:\temp\gwsavetest")
End Sub