'Создание карточки загрузки

Option Explicit
    Function DoEvent(UserSession, CardFrame, CardData, ActivateFlags, ModeID, FolderID, PropValue)
    Dim CardData2, Flag, Flag2, Prop1, Prop2, Prop3, Path, LeftPath
Set CardData2 = UserSession.CardManager.CardData("{DA46023A-280E-487D-8666-B6007F31F10F}")

'1 Проверка состояния

If GetProp(CardData, "Состояние загрузки", vbNullString) <> "Не начата" Then
  Exit Function
End If

'2 Вопрос пользоватею
    

If MsgBox("Внимание! Перед загрузкой Вы должны выполнить следующие действия:" & vbCrLf & "1. Сделать временную папку в папке <\\citrix-new\archive\upload> с любым названием. После успешной загрузки данных временная папка и все ее содержимое будет удалено." & vbCrLf & "2. В эту временную папку Вы должны поместить папки с заявками." & vbCrLf & "3. Пока данная загрузка не завершиться - Вы не сможете запустить следующую." & vbCrLf & "4. Процесс загрузки по данному запросу начнется в 22.00." & vbCrLf & " " & vbCrLf & "Если Вы все это сделали - нажмите <Да>, если нет - <Нет>.", vbYesNo Or vbInformation, "Внимание!") = vbNo Then
 
Exit Function
    End If

'3 Проверяем флаг
   If GetProp(CardData2, "Флаг", vbNullString) <> "1" Then
        MsgBox "Внимание! В настоящий момент уже запланирована или идет загрузка данных. Попробуйте повторить попытку позже.", vbOKOnly, "Предупреждение"
      
Exit Function
    End If

'4 Проверка папки
LeftPath = "\\Citrix-new\arhiv\Upload\"
Path = GetProp(CardData, "Корневая папка с папками заявок для загрузки", vbNullString)
Path = (Left(Path, 26))
If Path <> LeftPath Then
MsgBox "Внимание! Указана некорректная папка. Папка с данными должна быть в \\Citrix-new\arhiv\Upload", vbOKOnly, "Предупреждение"
Exit Function
    End If

'4 Установка флага
    Flag = "0"
    SetProp CardData2, "Флаг", Flag, Flag

'4 Установка флага (запланировано)
    Flag2 = "True"
    SetProp CardData, "Флаг (Запланировано)", Flag2, Flag2

Set Prop1 = Prop(CardData, "Кнопка")
Prop1.Value("Hidden") = True

Set Prop2 = Prop(CardData, "Корневая папка с папками заявок для загрузки")
Prop2.Value("ReadOnly") = True

Set Prop3 = Prop(CardData, "Информация о загружаемых данных")
Prop3.Value("ReadOnly") = True

DoEvent = 2 or 16 or 64
End Function

' Получение карточки папок
Function FolderCard(UserSession)
    Set FolderCard = UserSession.CardManager.Dictionary("{DA86FABF-4DD7-4A86-B6FF-C58C24D12DE2}")
End Function

' Копирование значения свойства2
Sub CopyProp2(SrcCardData, DestCardData, PropName)
    CopyProp SrcCardData, PropName, DestCardData, PropName
End Sub

' Копирование значения свойства
Sub CopyProp(SrcCardData, SrcPropName, DestCardData, DestPropName)
    Dim SrcProp
    Set SrcProp = Prop(SrcCardData, SrcPropName)
    SetProp DestCardData, DestPropName, SrcProp.Value("Value"), SrcProp.Value("DisplayValue")
End Sub

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

' Получение подчиненной секции по имени
Function SubSect(RowData, Alias)
    Set SubSect = RowData.ChildSections(RowData.Section.Type.ChildSections.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 GetProp(CardData, Alias, DefaultValue)
    Dim Row: Set Row = Prop(CardData, Alias)
    If Row Is Nothing Then
        GetProp = DefaultValue
    Else
        GetProp = Row.Value("Value")
        If IsNull(GetProp) Then GetProp = DefaultValue
    End If
End Function

' Установка значения свойства
Sub SetProp(CardData, Alias, Value, DisplayValue)
    Prop(CardData, Alias).Value("Value") = Value
    Prop(CardData, Alias).Value("DisplayValue") = DisplayValue
End Sub

' Вывести предупреждение
Sub ReportWarning(Msg)
    MsgBox Msg, vbExclamation Or vbOKOnly, "Предупреждение"
End Sub