Исходный код
Option Explicit
Call EditFile(ThisObject, "FILE_EXCEL", CreateObject("Excel.Application"))
'==============================================================================
' Добавить к объекту копию шаблонного файла Excel, и открыть его на редактирование
'==============================================================================
Sub EditFile(Obj, FDefSysName, ExcelApp)
Dim FDef, FDefs, FTemplate, Doc, ObjFiles, FName , NewObjFile
'Проверить что там с Excelem
If ExcelApp Is Nothing Then
MsgBox "Ошибка открытия Excel.", vbExclamation
Exit Sub
End If
On Error Resume Next
'Если типов файлов с указанным системным именем не найдено, выйти из процедуры
Set FDefs = ThisApplication.FileDefs
If Not FDefs.Has(FDefSysName) Then Exit Sub
'Получить ссылку на заданный тип файла
Set FDef = FDefs(FDefSysName)
If FDef.Templates.Count=0 Then
MsgBox "Шаблонов для типа файла " & FDefSysName & " не найдено.", vbInformation
Exit Sub
End If
'Получить ссылки на первый шаблонный файл данного типа и коллекцию файлов объекта
Set FTemplate = FDef.Templates(0)
Set ObjFiles = Obj.Files
'Задать имя, под которым файл будет добавлен...
FName = FDefSysName & "_test.xls"
'Если файл с таким именем уже в коллекции, запросить другое имя у пользователя
If ObjFiles.Has(FName) Then
While ObjFiles.Has(FName)
FName = InputBox("Введите другое имя файла (такое уже есть в коллекции):",, FName)
Wend
End If
'Разрешить любому пользователю
Obj.Permissions = SysAdminPermissions
'Добавить копию шаблонного файла в коллекцию файлов объекта (метод Add в данном случае
'использовать нельзя, он работает только с динамическими коллекциями файлов)
Set NewObjFile = ObjFiles.AddCopy(FTemplate, FName)
'Открыть файл объекта на редактирование
NewObjFile.CheckOut NewObjFile.WorkFileName
Set Doc = ExcelApp.Workbooks.Open(NewObjFile.WorkFileName)
ExcelApp.Cells(1,1).Value = Obj.GUID
ExcelApp.Visible = True
'Если была ошибка, сообщить об этом и главное - выйти из Excelя, а то процесс так и
'останется висеть в системе
If Err<>0 Then
ExcelApp.Quit
MsgBox "Ошибка добавления файла к объекту."_
& Chr(13) & "Код ошибки: " & Err, vbExclamation
End If
End Sub
'==============================================================================