'Исправил ошибку в функции getbodyImagefilename, где ей присваивается значение
Dim filenames() 'Глобальная переменная
'Процедура из которой будет вызываться функция выгрузки файлов на диск
'doc- документ карточка
Sub main(doc as NotesDocument)
Dim res as string
Redim filenames(0) As String
res = getbodyImagefilename(doc, "имя rtf поля в котором хранятся вложения")
'Если res не пустая, то хоть один файл да выгрузился на диск. Тогда выполняем с выгруженными файлами какие-нибудь действия
If res<>"" Then
'Здесь перечисляем файлы из глобальной переменной массива filenames с которыми можно уже что-то делать
ForAll fn in filenames
'Делаем что-нибудь с файлом и удаляем его с диска
Kill fn
End Forall
End If
End Sub
Function getbodyImagefilename(bodydoc As NotesDocument, rtname As String)
Dim TempDir As String
Dim body As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim att As NotesEmbeddedObject
Dim filepath As String
Dim i As Integer
getbodyImagefilename=""
'Если нет поля с вложениями, то выходим из функции
If bodydoc.HasItem(rtname)=False Then Exit Function
'Если в rtf поле нет вложений, то выходим из функции
If Not bodydoc.HasEmbedded Then Exit Function
Set body = bodydoc.GetFirstItem(rtname)
Set rtnav = body.CreateNavigator
TempDir$ = Environ("Temp")
If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
i=0
Do
Set att = rtnav.GetElement()
filepath$ = TempDir$ + "\" & att.Source
Redim Preserve filenames(i)
filenames(i)=filepath$
Call att.ExtractFile(filepath$)
i=i+1
Loop While rtnav.FindNextElement()
End If
getbodyImagefilename=filepath$
End Function
Dim filenames() 'Глобальная переменная
'Процедура из которой будет вызываться функция выгрузки файлов на диск
'doc- документ карточка
Sub main(doc as NotesDocument)
Dim res as string
Redim filenames(0) As String
res = getbodyImagefilename(doc, "имя rtf поля в котором хранятся вложения")
'Если res не пустая, то хоть один файл да выгрузился на диск. Тогда выполняем с выгруженными файлами какие-нибудь действия
If res<>"" Then
'Здесь перечисляем файлы из глобальной переменной массива filenames с которыми можно уже что-то делать
ForAll fn in filenames
'Делаем что-нибудь с файлом и удаляем его с диска
Kill fn
End Forall
End If
End Sub
Function getbodyImagefilename(bodydoc As NotesDocument, rtname As String)
Dim TempDir As String
Dim body As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim att As NotesEmbeddedObject
Dim filepath As String
Dim i As Integer
getbodyImagefilename=""
'Если нет поля с вложениями, то выходим из функции
If bodydoc.HasItem(rtname)=False Then Exit Function
'Если в rtf поле нет вложений, то выходим из функции
If Not bodydoc.HasEmbedded Then Exit Function
Set body = bodydoc.GetFirstItem(rtname)
Set rtnav = body.CreateNavigator
TempDir$ = Environ("Temp")
If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
i=0
Do
Set att = rtnav.GetElement()
filepath$ = TempDir$ + "\" & att.Source
Redim Preserve filenames(i)
filenames(i)=filepath$
Call att.ExtractFile(filepath$)
i=i+1
Loop While rtnav.FindNextElement()
End If
getbodyImagefilename=filepath$
End Function
Комментариев нет:
Отправить комментарий