Приветствую!

Наша организация юзает в качестве программы опративного учета Парус (Oracle), а в качестве электронного архива Директум(MSSQL). Была поставлена такая задача: открывать сканобраз документа из электронного архива в программе оперативного учета. Покопавшись на просторах инета и при помощи коллег из Ярославля и Москвы было создано пользовательсое приложение на VBA (маленькое, но симпатишное), которое позволяет это сделать.

+: открывает файлики связанной с расширением прогой
-: создает временный файл на диске

Всё работает, может кому пригодится.


Sub Open_Doc_From_Directum()

' Считаем штрихкод по которому будем искать документ
Query.SQL.Text = "select s.ssernumb from v_inorderspecs s where s.nrn="+Document
Query.Open

if Query.IsEmpty Then
MsgBox("Данных не найдено")
Else
kod = Query.FieldByName("ssernumb").Value
End If

Set WshShell = CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
sTEMP=WshShell.ExpandEnvironmentStrings(WshSysEnv("TEMP"))+"\"

'Создадим соединение с базой
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=SQLOLEDB;data Source='BasePics';Initial Catalog='Directum';User Id='User';Password='44444444'"

' Создадим и выполним запрос (если версий у документа несколькоко - возьмем последнюю)
Set rs = CreateObject("ADODB.Recordset")
sSQL = "SELECT TOP 1 * from SBEDocBarcode where KSNEABarcode like '%"+kod+"%' order by VersionDataLastUpd DESC"
rs.Open sSQL, cn, 1,3

If rs.EOF = True And rs.BOF = True Then
MsgBox("Такого документа нет в Директуме BasePix")
Exit Sub
End If

' Создадим поток и запиздякаем туда BLOB (в поле VersionData и есть данные)
Set mstream = CreateObject("ADODB.Stream")
mstream.Type = 1
mstream.Open
mstream.Write rs.Fields("VersionData").Value

' Сформируем имя файла (в поле TypeVersionData - расширение(тип) файла)
sNAME = sTEMP+"tmpfile."+rs.Fields("TypeVersionData")

'проверим есть ли такой файл и если есть- грохнем его (к сожалению интерпретатор Пруса не умеет перезаписывать файл, поэтому пришлось прибегнуть к этой маленькой кривизне)

Set FSO = CreateObject("Scripting.FileSystemObject")
if FSO.FileExists(sNAME)=true then FSO.DeleteFile sNAME end if

'Запишем в файл
mstream.SaveToFile sNAME

'Покажем файлик юзверю
WshShell.Run """"+sNAME+""""

rs.Close
cn.Close

End Sub