Данный скрипт выполняет следующие действия:
- Вызывает диалог выбора папки в которой будет создаваться карточка;
- Создает карточку с видом, назначенным на папку и открывает ее на редактирование.
Для его выполнения необходимо, чтобы на папку был назначен только один вид для создания документа.
Иначе скрипт не будет знать какого вида создавать карточку. Можно дописать и сделать выбор конкретного вида из списка видов, назначенных на папку. Но в данном случае было сделано так. Запускающим методом является процедура newCard.
Для работоспособности данного кода также необходимо, чтобы на рабочей станции, где будет запускаться скрипт был установлен клиент DocsVision 4.5.1988.
Данный код тестировался в Lotus Script. Скорее всего он будет работать и в других VB подобных языках программирования. Может быть с небольшой корректировкой.
Код:
Sub newCard()
Const ID_DICFOLDERSCARD = "{DA86FABF-4DD7-4A86-B6FF-C58C24D12DE2}" ' ИД карточки папок
Const ID_CARDIN = "{C1FED883-08DE-420F-8FB4-C16CEFFC1630}" ' ИД карточки типа входящий
Const ID_CARDINT = "{425DD1AC-8DF1-49F0-9A06-FA61381C4FEC}" 'ИД карточки типа внутренний
Const ID_CARDOUT = "{FA0C389E-1095-4BC1-BEDC-793463742571}" 'ИД карточки типа исходящий
Const ID_CARDARCH = "{A9E3F102-355B-477D-A9F2-99B02579F34E}" ' ИД карточки типа архивный
Const ID_CARDUNI = "{E724C058-B678-42FE-9C73-441705698CDB}" ' ИД карточки универсальный
' Строка подключения к серверу DocsVision по протоколу named pipe
'можно сделать и протоколу http. Как будет лучше так и сделать
Const ConnectString = "\\srv-dv\Pipe\DocsVision45\StorageServer"
Dim oSession As Variant
Dim Manager
Dim oTypesObject
Dim host As Variant
Dim oCard
Dim Navigator
Dim RowMainInfo
Set Navigator = CreateObject("DVNavigator.NavigatorControl")
Set Manager = CreateObject("DVObjectManager.SessionManager")
Set oTypesObject = CreateObject("TOHelperObjects.TypesObject")
Manager.Connect ConnectString
Set oSession = Manager.CreateSession()
If oSession Is Nothing Then
Msgbox "Невозможно создать сессию к DocsVision! За помощью обратитесь к администратору."
Exit Sub
End If
Set oTypesObject.UserSession = oSession
Set host = Navigator.CreateHost(oSession)
' Получаем карточку папок
Set oFolderCard = oSession.CardManager.Dictionary(ID_DICFOLDERSCARD)
' Выводим форму для выбора папки
FolderID = host.SelectFolder("Выбор папки для создаваемой карточки.")
' Получаем ИД вида документа по папке
DocsViewID = GetDocViewID(oFolderCard, FolderID)
If DocsViewID = "" Then
Msgbox "Для данной папки не удалось получить вид создаваемых документов. За помощью обратитесь к администратору."
Exit Sub
End If
' Получаем тип документа (Входящий = 0, Исходящий = 1, Внутренний = 2, Архивный = 3, Универсальный = 4)
DocType = GetDocTypeByDocView(oSession, DocsViewID)
' В зависимости от типа документа копируем в переменную DocTypeID соответствующий ИД типа документа
If DocType = -1 Then
Msgbox "Ошибка получения типа документа. За помощью обратитесь к администратору."
Exit Sub
End If
If DocType = 0 Then
DocTypeID = ID_CARDIN
End If
If DocType = 1 Then
DocTypeID = ID_CARDOUT
End If
If DocType = 2 Then
DocTypeID = ID_CARDINT
End If
If DocType = 3 Then
DocTypeID = ID_CARDARCH
End If
If DocType = 4 Then
DocTypeID = ID_CARDUNI
End If
' Создаем карточку документа
Set CardData = oSession.CardManager.CreateCardData(DocTypeID)
' Получаем первую строку основной секции карточки
Set RowMainInfo = CardData.Sections(CardData.Type.Sections.GetByAlias("MainInfo").ID).FirstRow
RowMainInfo.Value("Name") = "Имя документа"
Call oTypesObject.SetCardType(CardData.ID, DocsViewID, True, True, False, True, True, True, True)
'Здесь прописываются значения свойств документа.
' В закомментрированном ниже коде свойству Name присвоено значение: Test oMailItem.Subject
'Можно добавить свои свойства
' Set oName = GetProperty("Name", CardData, DocType)
' oName.Value("Value") = "Test oMailItem.Subject"
' oName.Value("TextValue") = "Test oMailItem.Subject"
' oName.Value("DisplayValue") = "Test oMailItem.Subject"
' Создаем слабый ярлык на карточку в выбранной папке
oFolderCard.CreateShortcut FolderID, CardData.ID, True
' Обновляем данные карточки
CardData.Refresh
' Отображаем карточку
host.ShowCard CardData.ID
End Sub
Function GetDocViewID(oFolderCard, FolderID)
GetDocViewID = ""
Set AllowedForFolderTypes = Nothing
'Получаем объект карточка папок
' Set oFolderCard = UserSession.CardManager.Dictionary(ID_FOLDERSCARD)
'Получаем объект папки в которой будет храниться карточка
Set oFolder = oFolderCard.GetFolder(FolderID)
'Получаем разрешенные для папки типы и возвращаем их из функции
'Если на папку не включено ограничение на создаваемые виды возвращаем Nothing, иначе список разрешенных видов
If (oFolder.Restrictions And FOLDER_RESTRICTED_TYPES) <> FOLDER_RESTRICTED_TYPES Then
Set AllowedForFolderTypes = Nothing
Else
Set AllowedForFolderTypes = oFolder.AllowedTypes
End If
If AllowedForFolderTypes Is Nothing Then
Msgbox "На папке не стоит ограничение на виды создаваемых в ней карточек. Карточка не будет создана. За помощью обратитесь к администратору."
Exit Function
End If
If AllowedForFolderTypes.Count = 0 Then
Msgbox "В списке ограничений папки на создаваемые виды не стоит ни один вид. Карточка не будет создана. За помощью обратитесть к администратору."
Exit Function
End If
If AllowedForFolderTypes.Count > 1 Then
Msgbox "В списке ограничений папки на создаваемые виды установлен больше чем один вид. Карточка не будет создана. За помощью обратитесь к администратору."
Exit Function
End If
GetDocViewID = AllowedForFolderTypes.Item(0).TypeID
End Function
Function GetDocTypeByDocView(UserSession, DocsViewID)
' По умолчанию тип карточки равен -1 (Теоретически. Что в принципе не может быть,
' так как у вида документа не может не быть типа карточки.)
'ID карточки типов
Dim oSectDocType As Variant
Const ID_TYPESCARD = "{BE14D55D-92B7-4345-AD10-32588981F83D}" 'ИД Карточки справочника типов
GetDocTypeByDocView = -1
Set oTypesCard = UserSession.CardManager.DictionaryData(ID_TYPESCARD)
Set oSectDocType = oTypesCard.Sections(oTypesCard.Type.AllSections.GetByAlias("DocumentTypes").ID)
Forall Row In oSectDocType.AllRows
If Row.Value("RowID") = DocsViewID Then
GetDocTypeByDocView = Row.Value("DocumentType")
Exit Function
End If
End Forall
End Function
Function GetProperty(tName, CardData, DocType)
Const ID_SECTPROP_CARDIN = "{B822D7D1-2280-4B51-AE58-A1CF757C5672}" 'Секция свойства карточки входящий документ
Const ID_SECTPROP_CARDINT = "{ 5B6B407E-3D72-49E7-97D9-8E1E028C7274}" 'Секция свойства карточки внутренний документ
Const ID_SECTPROP_CARDOUT = "{13A6A514-DC45-4078-AD02-66A79F896E68}" 'Секция свойства карточки исходящий документ
Const ID_SECTPROP_CARDARCH = "{ECD7A672-22E3-4748-9962-00FC0FE2ABBC}" 'Секция свойства карточки архивный документ
Const ID_SECTPROP_CARDUNI = "{D25F1089-C63D-43E1-9FA4-864C48EECCB4}" 'Секция свойства карточки универсальный документ
If DocType = 0 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDIN)
End If
If DocType = 1 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDOUT)
End If
If DocType = 2 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDINT)
End If
If DocType = 3 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDARCH)
End If
If DocType = 4 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDUNI)
End If
Set oProp=CardData.Sections(ID_SECTPROP_CARDIN)
Set oPropRow=oProp.FindRow("@Name='" & tName & "'")
Set GetProperty=oPropRow
End Function
- Вызывает диалог выбора папки в которой будет создаваться карточка;
- Создает карточку с видом, назначенным на папку и открывает ее на редактирование.
Для его выполнения необходимо, чтобы на папку был назначен только один вид для создания документа.
Иначе скрипт не будет знать какого вида создавать карточку. Можно дописать и сделать выбор конкретного вида из списка видов, назначенных на папку. Но в данном случае было сделано так. Запускающим методом является процедура newCard.
Для работоспособности данного кода также необходимо, чтобы на рабочей станции, где будет запускаться скрипт был установлен клиент DocsVision 4.5.1988.
Данный код тестировался в Lotus Script. Скорее всего он будет работать и в других VB подобных языках программирования. Может быть с небольшой корректировкой.
Код:
Sub newCard()
Const ID_DICFOLDERSCARD = "{DA86FABF-4DD7-4A86-B6FF-C58C24D12DE2}" ' ИД карточки папок
Const ID_CARDIN = "{C1FED883-08DE-420F-8FB4-C16CEFFC1630}" ' ИД карточки типа входящий
Const ID_CARDINT = "{425DD1AC-8DF1-49F0-9A06-FA61381C4FEC}" 'ИД карточки типа внутренний
Const ID_CARDOUT = "{FA0C389E-1095-4BC1-BEDC-793463742571}" 'ИД карточки типа исходящий
Const ID_CARDARCH = "{A9E3F102-355B-477D-A9F2-99B02579F34E}" ' ИД карточки типа архивный
Const ID_CARDUNI = "{E724C058-B678-42FE-9C73-441705698CDB}" ' ИД карточки универсальный
' Строка подключения к серверу DocsVision по протоколу named pipe
'можно сделать и протоколу http. Как будет лучше так и сделать
Const ConnectString = "\\srv-dv\Pipe\DocsVision45\StorageServer"
Dim oSession As Variant
Dim Manager
Dim oTypesObject
Dim host As Variant
Dim oCard
Dim Navigator
Dim RowMainInfo
Set Navigator = CreateObject("DVNavigator.NavigatorControl")
Set Manager = CreateObject("DVObjectManager.SessionManager")
Set oTypesObject = CreateObject("TOHelperObjects.TypesObject")
Manager.Connect ConnectString
Set oSession = Manager.CreateSession()
If oSession Is Nothing Then
Msgbox "Невозможно создать сессию к DocsVision! За помощью обратитесь к администратору."
Exit Sub
End If
Set oTypesObject.UserSession = oSession
Set host = Navigator.CreateHost(oSession)
' Получаем карточку папок
Set oFolderCard = oSession.CardManager.Dictionary(ID_DICFOLDERSCARD)
' Выводим форму для выбора папки
FolderID = host.SelectFolder("Выбор папки для создаваемой карточки.")
' Получаем ИД вида документа по папке
DocsViewID = GetDocViewID(oFolderCard, FolderID)
If DocsViewID = "" Then
Msgbox "Для данной папки не удалось получить вид создаваемых документов. За помощью обратитесь к администратору."
Exit Sub
End If
' Получаем тип документа (Входящий = 0, Исходящий = 1, Внутренний = 2, Архивный = 3, Универсальный = 4)
DocType = GetDocTypeByDocView(oSession, DocsViewID)
' В зависимости от типа документа копируем в переменную DocTypeID соответствующий ИД типа документа
If DocType = -1 Then
Msgbox "Ошибка получения типа документа. За помощью обратитесь к администратору."
Exit Sub
End If
If DocType = 0 Then
DocTypeID = ID_CARDIN
End If
If DocType = 1 Then
DocTypeID = ID_CARDOUT
End If
If DocType = 2 Then
DocTypeID = ID_CARDINT
End If
If DocType = 3 Then
DocTypeID = ID_CARDARCH
End If
If DocType = 4 Then
DocTypeID = ID_CARDUNI
End If
' Создаем карточку документа
Set CardData = oSession.CardManager.CreateCardData(DocTypeID)
' Получаем первую строку основной секции карточки
Set RowMainInfo = CardData.Sections(CardData.Type.Sections.GetByAlias("MainInfo").ID).FirstRow
RowMainInfo.Value("Name") = "Имя документа"
Call oTypesObject.SetCardType(CardData.ID, DocsViewID, True, True, False, True, True, True, True)
'Здесь прописываются значения свойств документа.
' В закомментрированном ниже коде свойству Name присвоено значение: Test oMailItem.Subject
'Можно добавить свои свойства
' Set oName = GetProperty("Name", CardData, DocType)
' oName.Value("Value") = "Test oMailItem.Subject"
' oName.Value("TextValue") = "Test oMailItem.Subject"
' oName.Value("DisplayValue") = "Test oMailItem.Subject"
' Создаем слабый ярлык на карточку в выбранной папке
oFolderCard.CreateShortcut FolderID, CardData.ID, True
' Обновляем данные карточки
CardData.Refresh
' Отображаем карточку
host.ShowCard CardData.ID
End Sub
Function GetDocViewID(oFolderCard, FolderID)
GetDocViewID = ""
Set AllowedForFolderTypes = Nothing
'Получаем объект карточка папок
' Set oFolderCard = UserSession.CardManager.Dictionary(ID_FOLDERSCARD)
'Получаем объект папки в которой будет храниться карточка
Set oFolder = oFolderCard.GetFolder(FolderID)
'Получаем разрешенные для папки типы и возвращаем их из функции
'Если на папку не включено ограничение на создаваемые виды возвращаем Nothing, иначе список разрешенных видов
If (oFolder.Restrictions And FOLDER_RESTRICTED_TYPES) <> FOLDER_RESTRICTED_TYPES Then
Set AllowedForFolderTypes = Nothing
Else
Set AllowedForFolderTypes = oFolder.AllowedTypes
End If
If AllowedForFolderTypes Is Nothing Then
Msgbox "На папке не стоит ограничение на виды создаваемых в ней карточек. Карточка не будет создана. За помощью обратитесь к администратору."
Exit Function
End If
If AllowedForFolderTypes.Count = 0 Then
Msgbox "В списке ограничений папки на создаваемые виды не стоит ни один вид. Карточка не будет создана. За помощью обратитесть к администратору."
Exit Function
End If
If AllowedForFolderTypes.Count > 1 Then
Msgbox "В списке ограничений папки на создаваемые виды установлен больше чем один вид. Карточка не будет создана. За помощью обратитесь к администратору."
Exit Function
End If
GetDocViewID = AllowedForFolderTypes.Item(0).TypeID
End Function
Function GetDocTypeByDocView(UserSession, DocsViewID)
' По умолчанию тип карточки равен -1 (Теоретически. Что в принципе не может быть,
' так как у вида документа не может не быть типа карточки.)
'ID карточки типов
Dim oSectDocType As Variant
Const ID_TYPESCARD = "{BE14D55D-92B7-4345-AD10-32588981F83D}" 'ИД Карточки справочника типов
GetDocTypeByDocView = -1
Set oTypesCard = UserSession.CardManager.DictionaryData(ID_TYPESCARD)
Set oSectDocType = oTypesCard.Sections(oTypesCard.Type.AllSections.GetByAlias("DocumentTypes").ID)
Forall Row In oSectDocType.AllRows
If Row.Value("RowID") = DocsViewID Then
GetDocTypeByDocView = Row.Value("DocumentType")
Exit Function
End If
End Forall
End Function
Function GetProperty(tName, CardData, DocType)
Const ID_SECTPROP_CARDIN = "{B822D7D1-2280-4B51-AE58-A1CF757C5672}" 'Секция свойства карточки входящий документ
Const ID_SECTPROP_CARDINT = "{ 5B6B407E-3D72-49E7-97D9-8E1E028C7274}" 'Секция свойства карточки внутренний документ
Const ID_SECTPROP_CARDOUT = "{13A6A514-DC45-4078-AD02-66A79F896E68}" 'Секция свойства карточки исходящий документ
Const ID_SECTPROP_CARDARCH = "{ECD7A672-22E3-4748-9962-00FC0FE2ABBC}" 'Секция свойства карточки архивный документ
Const ID_SECTPROP_CARDUNI = "{D25F1089-C63D-43E1-9FA4-864C48EECCB4}" 'Секция свойства карточки универсальный документ
If DocType = 0 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDIN)
End If
If DocType = 1 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDOUT)
End If
If DocType = 2 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDINT)
End If
If DocType = 3 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDARCH)
End If
If DocType = 4 Then
Set oProp=CardData.Sections(ID_SECTPROP_CARDUNI)
End If
Set oProp=CardData.Sections(ID_SECTPROP_CARDIN)
Set oPropRow=oProp.FindRow("@Name='" & tName & "'")
Set GetProperty=oPropRow
End Function
