Синхронизация данных карточки и формы InfoPath

Продолжая тему интеграции с офисными приложениями из VBS-скриптов (см. пост про работу с Word), привожу скрипт, работающий с формой InfoPath, вложенной в карточку документа в виде файла. Пафос слова "интеграция" несколько спадает если вспомнить, что форма InfoPath - это всего лишь XML файл.
Итак, что требовалось от скрипта:

• записывать значения заданных полей карточки документа в файл формы;
• записывать значения заданных полей формы InfoPath в карточку;
• производить указанные действия при открытии карточки и ее сохранении.

Алгоритм работы скрипта прост:

1. получить первый вложенный в карточку документа файл и выгрузить его на файловую систему во временный файл;
2. прочитать из файла значения заданных полей формы и записать их в поля (и/или пользовательские свойства) карточки документа;
3. записать в файл значения других заданных полей карточки в поля формы;
4. сохранить файл в карточке и удалить его с файловой системы.

Соответствие полей карточки и полей формы задается в скрипте в виде двух массивов (ReadMappings и WriteMappings). Поля формы задаются с помощью выражений XPath (что дает некоторую гибкость и универсальность). Поля карточки задаются по именам, которые интерпретируются в скрипте в функциях GetPropValue, GetPropDisplayValue и процедурах SetPropValue, SetPropDisplayValue. В этой интерпретации допущен некоторый произвол, благодаря которому в скрипте появились "псевдополя" типа поля "текущий пользователь открывший карточку" (@CurrentUser).
Для пользовательских свойств карточки отдельно синхронизируется значение и отдельно отображаемое значение.
А вот, собственно, и сам скрипт:

Function DoEvent(UserSession, CardFrame, CardData, ActivateFlags, ModeID, FolderID)
   StoreProps CardData, UserSession
   LoadProps CardData, UserSession
   DoEvent = 1
End Function


' Синхронизировать свойства из файла в карточку
Sub LoadProps(CardData, UserSession)
   Dim File, Path
   Set File = FirstFile(CardData, UserSession)
   If FIle Is Nothing Then Exit Sub
   Path = SaveFileOnFs(File)
   ReadPropsFromFile Path, CardData
   DeleteFileFromFs Path
End Sub

' Синхронизировать свойства из карточки в файл
Sub StoreProps(CardData, UserSession)
   Dim File, Path
   Set File = FirstFile(CardData, UserSession)
   If FIle Is Nothing Then Exit Sub
   Path = SaveFileOnFs(File)
   WritePropsToFile UserSession, Path, CardData
   File.Upload Path
   DeleteFileFromFs Path
End Sub

' Соответствие свойста карточки и полей xml-файла
Class PropMapping
   Public PropName
   Public ValueXPath
   Public DisplayValueXPath
End Class

' Создать соответствие свойста карточки и полей xml-файла
Function Map(PropName, ValueXPath, DisplayValueXPath)
   Set Map = New PropMapping
   With Map
       .PropName = PropName
       .ValueXPath = ValueXPath
       .DisplayValueXPath = DisplayValueXPath
   End With
End Function

' Соответствия свойств карточки и полей xml-файла для передачи из файла в карточку
Dim ReadMappings : ReadMappings = Array( _
   Map("Тема",                           "/my:Protocol/my:Subject",        "/my:Protocol/my:Subject"), _
   Map("Номер",                          "/my:Protocol/my:Number",         "/my:Protocol/my:Number"), _
   Map("Место совещания",                "/my:Protocol/my:Place",          "/my:Protocol/my:Place"), _
   Map("Подписанты",                     "/my:Protocol/my:AllSigners",     "/my:Protocol/my:AllSigners"), _
   Map("Участники",                      "/my:Protocol/my:AllAttendees",   "/my:Protocol/my:AllAttendees"), _
   Map("Присутствовали от контрагентов", "/my:Protocol/my:AllContragents", "/my:Protocol/my:AllContragents"), _
   Map("Дата",                           "/my:Protocol/my:Date",           "/my:Protocol/my:Date"), _
   Map("Филиал",                         "/my:Protocol/my:BranchID",       "/my:Protocol/my:BranchName") _
)

' Соответствия свойств карточки и полей xml-файла для передачи из карточки в файл
Dim WriteMappings : WriteMappings = Array( _
   Map("Регистратор",                    "/my:Protocol/my:RegistratorID",                  "/my:Protocol/my:RegistratorName"), _
   Map("Состояние",                      "/my:Protocol/my:State",                          "/my:Protocol/my:State"), _
   Map("Вид протокола",                  Null,                                             "/my:Protocol/my:Type"), _
   Map("ConfirmationStartProcessTempl",  "/my:Protocol/my:ConfirmationStartProcessTempl",  Null), _
   Map("ConfirmationStartProcessFolder", "/my:Protocol/my:ConfirmationStartProcessFolder", Null), _
   Map("ResolutionTemplateID",           "/my:Protocol/my:ResolutionTemplateID",           Null), _
   Map("ResolutionFolderID",             "/my:Protocol/my:ResolutionFolderID",             Null), _
   Map("DeliveryStartProcessTempl",      "/my:Protocol/my:DeliveryStartProcessTempl",      Null), _
   Map("DeliveryStartProcessFolder",     "/my:Protocol/my:DeliveryStartProcessFolder",     Null), _
   Map("@Card",                          "/my:Protocol/my:CardID",                         Null), _
   Map("@CurrentUser",                   "/my:Protocol/my:CurrentUserID",                  Null) _
)

' Прочитать свойства из xml-фала в карточку
Sub ReadPropsFromFile(Path, CardData)
   Dim XDoc, Mapping, CardProp
   Set XDoc = CreateObject("Msxml2.DOMDocument.3.0")
   XDoc.async = False
   XDoc.load Path
   For Each Mapping In ReadMappings
       If Not IsNull(Mapping.ValueXPath) Then
           SetPropValue CardData, Mapping.PropName, XDoc.selectSingleNode(Mapping.ValueXPath).Text
           If Not IsNull(Mapping.DisplayValueXPath) Then
               SetPropDisplayValue CardData, Mapping.PropName, XDoc.selectSingleNode(Mapping.DisplayValueXPath).Text
           End If
       End If
   Next
End Sub

' Записать свойства из карточки в xml-файл
Sub WritePropsToFile(UserSession, Path, CardData)
   Dim XDoc, Mapping, CardProp
   Set XDoc = CreateObject("Msxml2.DOMDocument.3.0")
   XDoc.async = False
   XDoc.load Path
   For Each Mapping In WriteMappings
       If Not IsNull(Mapping.ValueXPath) Then
           XDoc.selectSingleNode(Mapping.ValueXPath).Text = GetPropValue(UserSession, CardData, Mapping.PropName)
       End If
       If Not IsNull(Mapping.DisplayValueXPath) Then
           XDoc.selectSingleNode(Mapping.DisplayValueXPath).Text = GetPropDisplayValue(UserSession, CardData, Mapping.PropName)
       End If
   Next
   XDoc.save Path
End Sub

' Получение первого приложенного к карточке файла
Function FirstFile(CardData, UserSession)
   Dim FileList, FileRefs, VerFile, VersionID, FileID
   Set FileList = UserSession.CardManager.CardData(MainInfo(CardData).Value("FilesID"))
   Set FileRefs = Sect(FileList, "FileReferences")
   If FileRefs.Rows.Count = 0 Then
       Set FirstFile = Nothing
       Exit Function
   End If
   Set VerFile = UserSession.CardManager.CardData(FileRefs.Rows(0).Value("FileID"))
   VersionID = Sect(VerFile, "MainInfo").FirstRow.Value("CurrentID")
   FileID = Sect(VerFile, "Versions").GetRow(VersionID).Value("FileID")
   Set FirstFile = UserSession.FileManager.File(FileID)
End Function

' Сохранение файла на файловой системе во временный файл (возвращает путь к файлу)
Function SaveFileOnFs(File)
   Dim Fso, Fld
   Set Fso = CreateObject("Scripting.FileSystemObject")
   Set Fld = Fso.GetSpecialFolder(2)
   SaveFileOnFs = Fso.BuildPath(Fld.Path, Fso.GetTempName)
   File.Download SaveFileOnFs
End Function

' Удаление файла с файловой системы
Sub DeleteFileFromFs(Path)
   Dim Fso
   Set Fso = CreateObject("Scripting.FileSystemObject")
   Fso.DeleteFile Path, True
End Sub

' Получение секции карточки по имени
Function Sect(CardData, Alias)
   Set Sect = CardData.Sections(CardData.Type.AllSections.GetByAlias(Alias).ID)
End Function

' Нулевая строка секции MainInfo
Function MainInfo(CardData)
   Set MainInfo = Sect(CardData, "MainInfo").FirstRow
End Function

' Строка свойства
Function Prop(CardData, Alias)
   Set Prop = Nothing
   Dim Row: For Each Row In Sect(CardData, "Properties").Rows
       If Row.Value("Name") = Alias Then
           Set Prop = Row
           Exit Function
       End If
   Next
End Function

' Получение значения свойства
Function GetPropValue(UserSession, CardData, PropName)
   Select Case PropName
       Case "@Card"
           GetPropValue = CardData.ID
       Case "@CurrentUser"
           GetPropValue = StaffObject(UserSession).GetCurrentUserID
       Case Else
           Dim PropRow
           Set PropRow = Prop(CardData, PropName)
           GetPropValue = PropRow.Value("Value")
   End Select
End Function

' Получение отображаемого значения свойства
Function GetPropDisplayValue(UserSession, CardData, PropName)
   Select Case PropName
       Case "@Card"
           GetPropDisplayValue = CardData.Description
       Case "@CurrentUser"
           Dim Staff
           Set Staff = StaffObject(UserSession)
           GetPropDisplayValue = Staff.GetEmployeeName(Staff.GetCurrentUserID)
       Case Else
           Dim PropRow
           Set PropRow = Prop(CardData, PropName)
           GetPropDisplayValue = PropRow.Value("DisplayValue")
   End Select
End Function

' Установка значения свойства
Sub SetPropValue(CardData, PropName, Value)
   Select Case PropName
       Case "Дата"
           Value = CDate(Value)
   End Select
   Dim PropRow
   Set PropRow = Prop(CardData, PropName)
   PropRow.Value("Value") = Value
End Sub

' Установка отображаемого значения свойства
Sub SetPropDisplayValue(CardData, PropName, DisplayValue)
   Select Case PropName
       Case "@Card"
           CardData.Description = CStr(DisplayValue)
       Case Else
           Select Case PropName
               Case "Дата"
                   DisplayValue = FormatDateTime(CDate(DisplayValue), 2)
           End Select
           Dim PropRow
           Set PropRow = Prop(CardData, PropName)
           PropRow.Value("DisplayValue") = CStr(DisplayValue)
   End Select
End Sub

' Получение StaffObject
Function StaffObject(UserSession)
   Set StaffObject = CreateObject("TOHelperObjects.StaffObject")
   Set StaffObject.UserSession = UserSession
End Function

Читать дальше