commit da0bfe21eca7bd5da932e4c2ce99fd6248b722ee Author: IRBorisov <8611739+IRBorisov@users.noreply.github.com> Date: Fri Jun 7 19:50:21 2024 +0300 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c516907 --- /dev/null +++ b/.gitignore @@ -0,0 +1,21 @@ +__pycache__ +~$* + +*.spec +*.log +inputs +input.xlsx +output.csv +chromedriver.exe +Users.xlsx + +webapi/\!Контент.xlsm +webapi/bin/ +webapi/build/ +webapi/*.csv +webapi/exporter.ini +webapi/exporter.exe +webapi/*.xlsm +webapi/docx/*.docx +test/ +venv diff --git a/VBAMake.txt b/VBAMake.txt new file mode 100644 index 0000000..51cc9d2 --- /dev/null +++ b/VBAMake.txt @@ -0,0 +1,39 @@ +# == Properties Section == +# configuration properties +# use .ini format to define properties +# mandatory properties: name, artifact_home, source_home + +id = BRE +name = БРЭ +description = Интерфейс взаимодействия с Большой Российской Энциклопедией +artifact_home = BRE +source_home = BRE +install_home = D:\DEV\!WORK\output\BRE + +%% +# === Build section === +# Available commands: +# build LOCAL_MANIFEST +# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT] +# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT +# run LOCAL_SOURCE.bat + +run webapi\pyinstaller_run.bat +build script\databaseManifest.txt +copy webapi\bin\exporter.exe -> exporter.exe + +copy webapi\configs -> distr\configs +copy webapi\bin\exporter.exe -> distr\exporter.exe +copy webapi\bin\menu.exe -> distr\menu.exe +copy script\run_menu.bat -> distr\run_menu.bat +save_as !Контент.xlsm -> distr\!Контент.xlsm + +%% +# === Install section == +# Available commands: +# install LOCAL_ARTIFACT -> [INSTALL_PATH] +# add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE] +# run LOCAL_ARTIFACT.bat <- [PARAMETERS] +# run APPLICATION <- [PARAMETERS] + +# install !Контент.xlsm \ No newline at end of file diff --git a/script/LocalDevSetup.ps1 b/script/LocalDevSetup.ps1 new file mode 100644 index 0000000..661e428 --- /dev/null +++ b/script/LocalDevSetup.ps1 @@ -0,0 +1,32 @@ +# Create venv and install dependencies + imports + +$webapi = Resolve-Path -Path "$PSScriptRoot\..\webapi" +$envPath = "$webapi\venv" +$python = "$envPath\Scripts\python.exe" + +function LocalDevelopmentSetup() { + Set-Location $webapi + + ClearPrevious + CreateEnv + InstallPips +} + +function ClearPrevious() { + if (Test-Path -Path $envPath) { + Write-Host "Removing previous env: $envPath`n" -ForegroundColor DarkGreen + Remove-Item $envPath -Recurse -Force + } +} + +function CreateEnv() { + Write-Host "Creating python env: $envPath`n" -ForegroundColor DarkGreen + & 'python' -m venv $envPath +} + +function InstallPips() { + & $python -m pip install --upgrade pip + & $python -m pip install -r requirements_dev.txt +} + +LocalDevelopmentSetup \ No newline at end of file diff --git a/script/databaseManifest.txt b/script/databaseManifest.txt new file mode 100644 index 0000000..33e47b2 --- /dev/null +++ b/script/databaseManifest.txt @@ -0,0 +1,75 @@ +# == Properties Section == +# configuration properties +# use .ini format to define properties +# mandatory properties: name, artifact + +name = !Контент.xlsm +artifact = !Контент.xlsm + +%% +# === Imports Section === +# Hierarchy of folders and files +# Use Tabulator to mark next level in hierarchy +# All folders are nested into SharedHome path + +api + API_XLWrapper.cls + API_UserInteraction.cls + +utility + ex_MSHook.bas + ex_VBA.bas + ex_DataPreparation.bas + +excel + ex_Excel.bas + +ui + CSE_ProgressBar.frm + CSE_ListSelector.frm + +dev + DevTester.bas + +%% +# === Source Code Section == +# Hierarchy of folders and files +# Use Tabulator to mark next level in hierarchy +# All folders are nested into SourceHome path + +src + DevHelper.bas + Declarations.bas + Main.bas + MainImpl.bas + z_UIRibbon.bas + z_UIMessages.bas + + DB_Content.cls + DB_Workers.cls + InfoConfig.cls + IteratorAttribute.cls + IteratorContent.cls + IteratorCSVTasks.cls + IteratorCSVContent.cls + +%% +# ===== UI Section ======= +# Pairs of path to UI elements, use " -> " delimiter +# First component is a path relative to SourceHome\ui folders +# Second component is internal path inside project file + +.rels -> _rels\.rels +customUI.xml -> customUI\customUI.xml + +%% +# === References Section === +# List dependencies in one of the formats +# global : GLOBAL_NAME +# guid : {REGISTERED_GUID} +# file : PATH_TO_LIBRARY + +global : Scripting +global : MSForms +global : ADODB +global : IWshRuntimeLibrary \ No newline at end of file diff --git a/script/run_menu.bat b/script/run_menu.bat new file mode 100644 index 0000000..75aa02b --- /dev/null +++ b/script/run_menu.bat @@ -0,0 +1,5 @@ +@echo off + +menu.exe + +pause \ No newline at end of file diff --git a/skeleton/!Контент.xlsm b/skeleton/!Контент.xlsm new file mode 100644 index 0000000..8f635c9 Binary files /dev/null and b/skeleton/!Контент.xlsm differ diff --git a/src/DB_Content.cls b/src/DB_Content.cls new file mode 100644 index 0000000..639085b --- /dev/null +++ b/src/DB_Content.cls @@ -0,0 +1,126 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "DB_Content" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private data_ As Excel.Worksheet +Private attributes_ As Excel.Worksheet + +Public Function Init(iData As Excel.Worksheet, iAttributes As Excel.Worksheet) + Set data_ = iData + Set attributes_ = iAttributes +End Function + +Public Function Attributes() As IteratorAttribute + Set Attributes = New IteratorAttribute + Call Attributes.Init(attributes_) +End Function + +Public Function IBegin() As IteratorContent + Set IBegin = New IteratorContent + Call IBegin.Init(data_) +End Function + +Public Function ILast() As IteratorContent + Set ILast = New IteratorContent + Call ILast.Init(data_) + Call ILast.GoLast +End Function + +Public Function INew() As IteratorContent + Set INew = New IteratorContent + Call INew.Init(data_) + Call INew.GoLast + Call INew.Increment +End Function + +Public Property Get Count() As Long + Count = ILast.row_ - IBegin.row_ + 1 +End Property + +Public Function FindTaskID(sID$) As IteratorContent + Dim iResult As IteratorContent: Set iResult = IBegin + If iResult.FindTaskID(sID) Then _ + Set FindTaskID = iResult +End Function + +Public Function FindContentName(sName$, sType$) As IteratorContent + Dim iResult As IteratorContent: Set iResult = IBegin + If iResult.FindContentName(sName, sType) Then _ + Set FindContentName = iResult +End Function + +Public Function EnsureDataVisible() + Call XLShowAllData(data_, bKeepColumns:=True) + Call XLShowAllData(attributes_) +End Function + +Public Function ImportCSVTasks(iInput As IteratorCSVTasks) + Call iInput.GoFirst + Dim iOutput As IteratorContent + Do While Not iInput.IsDone + Set iOutput = FindPlaceFor(iInput.TaskID, iInput.ContentName, iInput.TaskType) + If Not iInput.IsCanceled Or iOutput.TaskType <> "" Then + Call iOutput.SyncCSVTasks(iInput) + End If + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.IncrementA + Call iInput.Increment + Loop +End Function + +Public Function ImportCSVContent(iInput As IteratorCSVContent) + Call iInput.GoFirst + Dim iOutput As IteratorContent + Do While Not iInput.IsDone + Set iOutput = FindPlaceFor(iInput.TaskID) + Call iOutput.SyncCSVContent(iInput) + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.IncrementA + Call iInput.Increment + Loop +End Function + +Public Function ImportDB(iData As DB_Content) + Dim iInput As IteratorContent: Set iInput = iData.IBegin() + Dim iOutput As IteratorContent + Do While Not iInput.IsDone + Set iOutput = FindPlaceFor(iInput.TaskID, iInput.ContentName, iInput.TaskType) + If Not iInput.IsCanceled Or iOutput.TaskType <> "" Then _ + Call iOutput.SyncContent(iInput) + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.IncrementA + Call iInput.Increment + Loop + Call ImportAttributes(iData.Attributes) +End Function + +' ======= +Private Function FindPlaceFor(sID$, Optional sName$ = "", Optional sType$ = "") As IteratorContent + Dim iWhere As IteratorContent: Set iWhere = IBegin + If Not iWhere.FindTaskID(sID) Then _ + If Not iWhere.FindContentName(sName, sType) Or iWhere.TaskID <> "" Then _ + Call iWhere.GoEmpty + Set FindPlaceFor = iWhere +End Function + +Private Function ImportAttributes(iInput As IteratorAttribute) + Dim iOutput As IteratorAttribute: Set iOutput = Attributes + Call iOutput.GoEmpty + Do While Not iInput.IsDone + Call iOutput.SyncWith(iInput) + Call iOutput.Increment + Call iInput.Increment + Loop + Call DeleteAttributeDuplicates +End Function + +Private Function DeleteAttributeDuplicates() + +End Function diff --git a/src/DB_Workers.cls b/src/DB_Workers.cls new file mode 100644 index 0000000..8615a04 --- /dev/null +++ b/src/DB_Workers.cls @@ -0,0 +1,28 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "DB_Workers" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private data_ As Excel.ListObject + +Public Function Init(oTable As Excel.ListObject) + Set data_ = oTable +End Function + +Public Function ExpandShortname(sShort$) As String + Dim dataRng As Excel.Range: Set dataRng = data_.Range + Dim nRow& + For nRow = 2 To dataRng.Rows.Count Step 1 + If dataRng.Cells(nRow, 2) = sShort Then + ExpandShortname = dataRng.Cells(nRow, 1) + Exit Function + End If + Next nRow + ExpandShortname = sShort +End Function diff --git a/src/Declarations.bas b/src/Declarations.bas new file mode 100644 index 0000000..58266f0 --- /dev/null +++ b/src/Declarations.bas @@ -0,0 +1,82 @@ +Attribute VB_Name = "Declarations" +Option Private Module +Option Explicit + +Public Const DATA_FIRST_ROW = 2 + +Public Const NO_CONTENT_PLACEHOLDER = " " +Public Const NO_MEDIA_PLACEHOLDER = " " + +Public Const STATUS_CANCELED = "" +Public Const BOOL_TEXT_YES = "" +Public Const BOOL_TEXT_NO = "" + +Public Const SHEET_CONTENT = "" +Public Const SHEET_OPTIONS = "" +Public Const SHEET_ATTRIBUTES = "" +Public Const SHEET_CONFIG = "" + +Public Const TABLE_WORKERS = "t_Person" +Public Const TABLE_MARKERS = "t_Markers" +Public Const TABLE_TAGS = "t_Tags" + +Public Const URL_PREFIX_TASK = "https://rk.greatbook.ru/tasks/" +Public Const URL_PREFIX_CONTENT = "https://rk.greatbook.ru/widgets?link=task&id=" + +Public Const EXPORTER_CONFIG_FILE = "exporter.ini" +Public Const EXPORTER_EXECUTABLE = "exporter.exe" + +Public Const PREFIX_IMMUTABLE = " " +Public Const SUFFIX_IMMUTABLE = " (++)" + +Public Enum TUpdateStatus + T_UPD_UNDEF = 0 + [_First] = 1 + + T_UPD_COMPLETE = 1 + T_UPD_IGNORE = 2 + T_UPD_AUTO = 3 + T_UPD_ONCE = 4 + T_UPD_ALWAYS = 5 + + [_Last] = 5 +End Enum + +Public Function InferContentFromTask(sTask$) As String + Dim sContent$: sContent = sTask + If sContent Like PREFIX_IMMUTABLE & "*" Then _ + sContent = VBA.Right(sContent, VBA.Len(sContent) - VBA.Len(PREFIX_IMMUTABLE)) + If sContent Like "*" & SUFFIX_IMMUTABLE Then _ + sContent = VBA.Left(sContent, VBA.Len(sContent) - VBA.Len(SUFFIX_IMMUTABLE)) + InferContentFromTask = sContent +End Function + +Public Function UpdateStatusFromText(sText$) As TUpdateStatus + If sText = "" Then + UpdateStatusFromText = T_UPD_COMPLETE + ElseIf sText = "" Then + UpdateStatusFromText = T_UPD_IGNORE + ElseIf sText = "" Then + UpdateStatusFromText = T_UPD_AUTO + ElseIf sText = "" Then + UpdateStatusFromText = T_UPD_ONCE + ElseIf sText = "" Then + UpdateStatusFromText = T_UPD_ALWAYS + Else + UpdateStatusFromText = T_UPD_UNDEF + End If +End Function + +Public Function UpdateStatusToText(iStatus As TUpdateStatus) As String + Select Case iStatus + Case T_UPD_UNDEF: UpdateStatusToText = "" + Case T_UPD_COMPLETE: UpdateStatusToText = "" + Case T_UPD_IGNORE: UpdateStatusToText = "" + Case T_UPD_AUTO: UpdateStatusToText = "" + Case T_UPD_ONCE: UpdateStatusToText = "" + Case T_UPD_ALWAYS: UpdateStatusToText = "" + Case Else: UpdateStatusToText = "" + End Select +End Function + + diff --git a/src/DevHelper.bas b/src/DevHelper.bas new file mode 100644 index 0000000..6efaa08 --- /dev/null +++ b/src/DevHelper.bas @@ -0,0 +1,20 @@ +Attribute VB_Name = "DevHelper" +Option Explicit + +Public Function Dev_PrepareSkeleton() + Call ClearData +End Function + +Public Sub Dev_ManualRunTest() + Dim sSuite$: sSuite = "s_Database" + Dim sTest$: sTest = "t_RenameLawFile" + Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest) + Debug.Print sMsg + Call MsgBox(sMsg) +End Sub + +Public Function Dev_GetTestSuite(sName$) As Object + Select Case sName +' Case "s_ActiveStateExporter": Set Dev_GetTestSuite = New s_ActiveStateExporter + End Select +End Function diff --git a/src/InfoConfig.cls b/src/InfoConfig.cls new file mode 100644 index 0000000..0c5ca40 --- /dev/null +++ b/src/InfoConfig.cls @@ -0,0 +1,163 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "InfoConfig" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private Const S_CONFIG_KEY = 1 +Private Const S_CONFIG_VALUE = 2 +Private Const S_CONFIG_COMMENT = 3 + +Private Enum AppdataRows + [_First] = 2 + + R_APP_FILTER_TASK = 2 + R_APP_FILTER_DEPARTMENT = 3 + R_APP_FILTER_STATUS = 4 + R_APP_FILTER_RESPONSIBLE = 5 + R_APP_FILTER_SUPERVISOR = 6 + R_APP_FILTER_EXECUTOR = 7 + R_APP_FILTER_OBSERVER = 8 + + R_APP_FILTER_CREATED_BEGIN = 9 + R_APP_FILTER_CREATED_END = 10 + R_APP_FILTER_TARGET_BEGIN = 11 + R_APP_FILTER_TARGET_END = 12 + + R_APP_OUTPUT = 13 + R_APP_SCAN_TASKS = 14 + R_APP_SCAN_CONTENT = 15 + R_APP_OUTPUT_CONTENT = 16 + R_APP_ACCESS_TOKEN = 17 + + [_Last] = 17 +End Enum + +Private Enum UserRows + [_First] = 19 + + R_USER_NAME = 19 + R_USER_LOGIN = 20 + R_USER_PASSWORD = 21 + + [_Last] = 21 +End Enum + +Private Enum OptionsRows + [_First] = 23 + + R_OPT_DEBUG = 23 + R_OPT_TESTRUN = 24 + R_OPT_TIMEOUT = 25 + + [_Last] = 25 +End Enum + +Private data_ As Excel.Worksheet +Private content_ As DB_Content + +Public Function Init(iData As Excel.Worksheet, iContent As DB_Content) + Set data_ = iData + Set content_ = iContent +End Function + +Public Function SetScanContent(bScanContent As Boolean) + data_.Cells(R_APP_SCAN_CONTENT, S_CONFIG_VALUE) = IIf(bScanContent, "true", "false") +End Function + +Public Function SetScanTasks(bScanContent As Boolean) + data_.Cells(R_APP_SCAN_TASKS, S_CONFIG_VALUE) = IIf(bScanContent, "true", "false") +End Function + +Public Function ConfigFilePath() As String + ConfigFilePath = data_.Parent.Path & "\" & EXPORTER_CONFIG_FILE +End Function + +Public Function OutputFileTasks() As String + OutputFileTasks = data_.Parent.Path & "\" & data_.Cells(R_APP_OUTPUT, S_CONFIG_VALUE) +End Function + +Public Function OutputFileContent() As String + OutputFileContent = data_.Parent.Path & "\" & data_.Cells(R_APP_OUTPUT_CONTENT, S_CONFIG_VALUE) +End Function + +Public Function ScanContent() As Boolean + ScanContent = data_.Cells(R_APP_SCAN_CONTENT, S_CONFIG_VALUE) +End Function + +Public Function ScanTasks() As Boolean + ScanTasks = data_.Cells(R_APP_SCAN_TASKS, S_CONFIG_VALUE) +End Function + +Public Function CreateConfigFile() + Dim nRow& + Dim sValue$, sKey$ + Dim iOut As New ADODB.Stream: iOut.Charset = "utf-8" + Call iOut.Open + + Call iOut.WriteText("[AppData]", adWriteLine) + For nRow = AppdataRows.[_First] To AppdataRows.[_Last] Step 1 + sKey = data_.Cells(nRow, S_CONFIG_KEY) + sValue = data_.Cells(nRow, S_CONFIG_VALUE) + Call iOut.WriteText(Fmt("{1}={2}", sKey, sValue), adWriteLine) + Next nRow + Call PrepareLists(iOut) + + Call iOut.WriteText("[Options]", adWriteLine) + For nRow = OptionsRows.[_First] To OptionsRows.[_Last] Step 1 + sKey = data_.Cells(nRow, S_CONFIG_KEY) + sValue = data_.Cells(nRow, S_CONFIG_VALUE) + Call iOut.WriteText(Fmt("{1}={2}", sKey, sValue), adWriteLine) + Next nRow + + Call iOut.WriteText("[UserData]", adWriteLine) + For nRow = UserRows.[_First] To UserRows.[_Last] Step 1 + sKey = data_.Cells(nRow, S_CONFIG_KEY) + sValue = data_.Cells(nRow, S_CONFIG_VALUE) + Call iOut.WriteText(Fmt("{1}={2}", sKey, sValue), adWriteLine) + Next nRow + + Dim iOutNoBOM As New ADODB.Stream + iOutNoBOM.Type = adTypeBinary + Call iOutNoBOM.Open + + iOut.Position = 3 + Call iOut.CopyTo(iOutNoBOM) + + Call iOutNoBOM.SaveToFile(ConfigFilePath, adSaveCreateOverWrite) + Call iOutNoBOM.Close + + Call iOut.Close +End Function + +Public Function DeleteConfigFile() + Call Kill(ConfigFilePath) +End Function + +' ======== +Private Function PrepareLists(iOut As ADODB.Stream) As String + Dim iExclude$: iExclude = "" + Dim iInclude$: iInclude = "" + Dim iContent As IteratorContent: Set iContent = content_.IBegin + Dim iStatus As TUpdateStatus + Do While Not iContent.IsDone + Call iContent.RecalculateStatus + If iContent.IsIgnored Then + If iExclude <> "" Then iExclude = iExclude & ";" + iExclude = iExclude & iContent.TaskID + End If + If iContent.NeedsUpdate Then + If iInclude <> "" Then iInclude = iInclude & ";" + iInclude = iInclude & iContent.TaskID + End If + Call iContent.Increment + Loop + + Call iOut.WriteText(Fmt("{1}={2}", "ExcludeID", iExclude), adWriteLine) + Call iOut.WriteText(Fmt("{1}={2}", "IncludeID", iInclude), adWriteLine) +End Function diff --git a/src/IteratorAttribute.cls b/src/IteratorAttribute.cls new file mode 100644 index 0000000..688872c --- /dev/null +++ b/src/IteratorAttribute.cls @@ -0,0 +1,99 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorAttribute" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' _A_ Attrtibutes structure +Private Enum AttributesStruct + [_First] = 1 + + S_A_CONTENT_NAME = 1 + S_A_ATTRIBUTE = 2 + S_A_VALUE = 3 + S_A_INPUT_METHOD = 4 + + [_Last] = 4 +End Enum + +Public row_ As Long + +Private data_ As Excel.Worksheet + +Public Sub Init(target As Excel.Worksheet, Optional tRow& = DATA_FIRST_ROW) + Set data_ = target + row_ = tRow +End Sub + +Public Function Increment(Optional inc& = 1) + If row_ + inc > 0 Then _ + row_ = row_ + inc +End Function + +Public Function GoFirst() + row_ = DATA_FIRST_ROW +End Function + +Public Function GoLast() + row_ = GetLastRow +End Function + +Public Function GoEmpty() + Call GoLast + Call Increment +End Function + +Public Function IsDone() As Boolean + IsDone = row_ > GetLastRow +End Function + +Public Function SyncWith(iInput As IteratorAttribute) + ContentName = iInput.ContentName + Attr = iInput.Attr + Value = iInput.Value + InputMethod = iInput.InputMethod +End Function + +' ======== Property Get ========= +Public Property Get ContentName() As String + ContentName = data_.Cells(row_, S_A_CONTENT_NAME) +End Property + +Public Property Get Attr() As String + Attr = data_.Cells(row_, S_A_ATTRIBUTE) +End Property + +Public Property Get Value() As String + Value = data_.Cells(row_, S_A_VALUE) +End Property + +Public Property Get InputMethod() As String + InputMethod = data_.Cells(row_, S_A_INPUT_METHOD) +End Property + +' ==== Property Let ==== +Public Property Let ContentName(newVal$) + data_.Cells(row_, S_A_CONTENT_NAME) = newVal +End Property + +Public Property Let Attr(newVal$) + data_.Cells(row_, S_A_ATTRIBUTE) = newVal +End Property + +Public Property Let Value(newVal$) + data_.Cells(row_, S_A_VALUE) = newVal +End Property + +Public Property Let InputMethod(newVal$) + data_.Cells(row_, S_A_INPUT_METHOD) = newVal +End Property + +' ======= +Private Function GetLastRow() As Long + GetLastRow = data_.Cells(data_.Rows.Count, 1).End(xlUp).Row +End Function diff --git a/src/IteratorCSVContent.cls b/src/IteratorCSVContent.cls new file mode 100644 index 0000000..265a7a4 --- /dev/null +++ b/src/IteratorCSVContent.cls @@ -0,0 +1,134 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorCSVContent" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' _I_ Input CSV structure +Private Enum InputStruct + [_First] = 1 + + S_I_TASK_ID = 1 + S_I_BIBLIO_NAME = 2 + S_I_CHANGE_SCORE = 3 + S_I_DEPARTMENT = 4 + S_I_RESPONSIBLE = 5 + S_I_DEFINITION = 6 + S_I_OBJECT_TYPE = 7 + S_I_MARKERS = 8 + S_I_TAGS = 9 + S_I_SOURCE = 10 + S_I_ELECTRON_BRE = 11 + S_I_MAIN_PAGE = 12 + S_I_IS_GENERAL = 13 + S_I_ACTUALIZE_PERIOD = 14 + S_I_AGE_RESTRICTION = 15 + S_I_AUTHOR = 16 + S_I_EDITOR = 17 + + [_Last] = 17 +End Enum + +Public row_ As Long + +Private data_ As Excel.Worksheet + +Public Sub Init(target As Excel.Worksheet, Optional tRow& = 1) + Set data_ = target + row_ = tRow +End Sub + +Public Function Increment(Optional inc& = 1) + If row_ + inc > 0 Then _ + row_ = row_ + inc +End Function + +Public Function GoFirst() + row_ = 1 +End Function + +Public Function GoLast() + row_ = data_.Columns(S_I_TASK_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Function + +Public Property Get CountRows() As Long + CountRows = data_.Columns(S_I_TASK_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Property + +Public Function IsDone() As Boolean + IsDone = data_.Cells(row_, S_I_TASK_ID) = vbNullString +End Function + +'===== Propertiy Get ===== +Public Property Get TaskID() As String + TaskID = data_.Cells(row_, S_I_TASK_ID) +End Property + +Public Property Get BiblioName() As String + BiblioName = data_.Cells(row_, S_I_BIBLIO_NAME) +End Property + +Public Property Get ChangeScore() As String + ChangeScore = data_.Cells(row_, S_I_CHANGE_SCORE) +End Property + +Public Property Get Department() As String + Department = data_.Cells(row_, S_I_DEPARTMENT) +End Property + +Public Property Get Responsible() As String + Responsible = data_.Cells(row_, S_I_RESPONSIBLE) +End Property + +Public Property Get Definition() As String + Definition = data_.Cells(row_, S_I_DEFINITION) +End Property + +Public Property Get ObjectType() As String + ObjectType = data_.Cells(row_, S_I_OBJECT_TYPE) +End Property + +Public Property Get Markers() As String + Markers = data_.Cells(row_, S_I_MARKERS) +End Property + +Public Property Get Tags() As String + Tags = data_.Cells(row_, S_I_TAGS) +End Property + +Public Property Get Source() As String + Source = data_.Cells(row_, S_I_SOURCE) +End Property + +Public Property Get ElectronBre() As String + ElectronBre = data_.Cells(row_, S_I_ELECTRON_BRE) +End Property + +Public Property Get MainPage() As String + MainPage = data_.Cells(row_, S_I_MAIN_PAGE) +End Property + +Public Property Get IsGeneral() As String + IsGeneral = data_.Cells(row_, S_I_IS_GENERAL) +End Property + +Public Property Get ActualizePeriod() As String + ActualizePeriod = data_.Cells(row_, S_I_ACTUALIZE_PERIOD) +End Property + +Public Property Get AgeRestriction() As String + AgeRestriction = data_.Cells(row_, S_I_AGE_RESTRICTION) +End Property + +Public Property Get Author() As String + Author = data_.Cells(row_, S_I_AUTHOR) +End Property + +Public Property Get Editor() As String + Editor = data_.Cells(row_, S_I_EDITOR) +End Property diff --git a/src/IteratorCSVTasks.cls b/src/IteratorCSVTasks.cls new file mode 100644 index 0000000..14a09da --- /dev/null +++ b/src/IteratorCSVTasks.cls @@ -0,0 +1,118 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorCSVTasks" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' _I_ Input CSV structure +Private Enum InputStruct + [_First] = 1 + + S_I_TASK_TYPE = 1 + S_I_STATUS = 2 + S_I_CONTENT_NAME_DB = 3 + S_I_SUPERVISOR = 4 + S_I_EXECUTOR = 5 + S_I_TARGET_DATE = 6 + S_I_TASK_ID = 7 + S_I_TASK_NAME = 8 + S_I_PARENT_ID = 9 + + [_Last] = 9 +End Enum + +Public row_ As Long + +Private data_ As Excel.Worksheet +Private workers_ As DB_Workers + +Public Sub Init(target As Excel.Worksheet, dbWorkers As DB_Workers, Optional tRow& = 1) + Set data_ = target + row_ = tRow + Set workers_ = dbWorkers +End Sub + +Public Function Increment(Optional inc& = 1) + If row_ + inc > 0 Then _ + row_ = row_ + inc +End Function + +Public Function GoFirst() + row_ = 1 +End Function + +Public Function GoLast() + row_ = data_.Columns(S_I_TASK_TYPE).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Function + +Public Property Get CountRows() As Long + CountRows = data_.Columns(S_I_TASK_TYPE).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Property + +Public Function IsDone() As Boolean + IsDone = data_.Cells(row_, S_I_TASK_TYPE) = vbNullString +End Function + +Public Function IsCanceled() As Boolean + IsCanceled = Status = STATUS_CANCELED +End Function + +Public Function HasContent() As Boolean + Dim sContent$: sContent = ContentNameDB + HasContent = sContent <> NO_CONTENT_PLACEHOLDER And sContent <> NO_MEDIA_PLACEHOLDER +End Function + +'===== Propertiy Get ===== +Public Property Get TaskType() As String + Dim sText$: sText = data_.Cells(row_, S_I_TASK_TYPE) + If sText = " " Then + TaskType = " " + Else + TaskType = CapitalizeFirstLetter(VBA.LCase(sText)) + End If +End Property + +Public Property Get Status() As String + Status = data_.Cells(row_, S_I_STATUS) +End Property + +Public Property Get ContentName() As String + If Not HasContent Then + ContentName = InferContentFromTask(TaskName) + Else + ContentName = ContentNameDB + End If +End Property + +Public Property Get ContentNameDB() As String + ContentNameDB = data_.Cells(row_, S_I_CONTENT_NAME_DB) +End Property + +Public Property Get Supervisor() As String + Supervisor = workers_.ExpandShortname(data_.Cells(row_, S_I_SUPERVISOR)) +End Property + +Public Property Get Executor() As String + Executor = workers_.ExpandShortname(data_.Cells(row_, S_I_EXECUTOR)) +End Property + +Public Property Get TargetDate() As Long + TargetDate = VBA.CDate(data_.Cells(row_, S_I_TARGET_DATE)) +End Property + +Public Property Get TaskID() As String + TaskID = data_.Cells(row_, S_I_TASK_ID) +End Property + +Public Property Get TaskName() As String + TaskName = data_.Cells(row_, S_I_TASK_NAME) +End Property + +Public Property Get ParentID() As String + ParentID = data_.Cells(row_, S_I_PARENT_ID) +End Property diff --git a/src/IteratorContent.cls b/src/IteratorContent.cls new file mode 100644 index 0000000..f2488e0 --- /dev/null +++ b/src/IteratorContent.cls @@ -0,0 +1,595 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorContent" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' _C_ Content structure +Private Enum ContentStruct + [_First] = 1 + + S_C_TASK_TYPE = 1 + S_C_STATUS = 2 + S_C_CONTENT_NAME = 3 + S_C_UPDATE_STATUS = 4 + S_C_CHANGE_SCORE = 5 + S_C_BIBLIO_NAME = 6 + S_C_DEFINITION = 7 + S_C_IS_IMMUTABLE = 8 + S_C_OBJECT_TYPE = 9 + S_C_MARKERS = 10 + S_C_TAGS = 11 + S_C_AUTHOR = 12 + S_C_SUPERVISOR = 13 + S_C_EXECUTOR = 14 + S_C_EDITOR = 15 + S_C_RESPONSIBLE = 16 + S_C_DEPARTMENT = 17 + S_C_TARGET_DATE = 18 + S_C_SOURCE = 19 + S_C_ELECTRON_BRE = 20 + S_C_MAIN_PAGE = 21 + S_C_IS_GENERAL = 22 + S_C_ACTUALIZE_PERIOD = 23 + S_C_AGE_RESTRICTION = 24 + S_C_PRIORITY = 25 + S_C_ARTICLE_TYPE = 26 + S_C_DATE_EXCHANGE = 27 + S_C_DATE_EES1 = 28 + S_C_DATE_EX_TOOLS = 29 + S_C_DATE_EES2 = 30 + S_C_EXPERT = 31 + S_C_CONTRACT = 32 + S_C_COMMENT = 33 + S_C_TASK_ID = 34 + S_C_CONTENT_NAME_DB = 35 + S_C_TASK_NAME = 36 + S_C_PARENT_ID = 37 + + [_Last] = 37 +End Enum + +Public row_ As Long + +Private data_ As Excel.Worksheet + +Public Sub Init(target As Excel.Worksheet, Optional tRow& = DATA_FIRST_ROW) + Set data_ = target + row_ = tRow +End Sub + +Public Function Increment(Optional inc& = 1) + If row_ + inc > 0 Then _ + row_ = row_ + inc +End Function + +Public Function GoFirst() + row_ = DATA_FIRST_ROW +End Function + +Public Function GoLast() + row_ = GetLastRow +End Function + +Public Function GoEmpty() + Call GoLast + Call Increment +End Function + +Public Function IsDone() As Boolean + IsDone = row_ > GetLastRow +End Function + +Public Function IsCanceled() As Boolean + IsCanceled = Status = STATUS_CANCELED +End Function + +Public Function HasContent() As Boolean + Dim sContent$: sContent = ContentNameDB + HasContent = sContent <> NO_CONTENT_PLACEHOLDER And sContent <> NO_MEDIA_PLACEHOLDER +End Function + +Public Function RemoveRow() + Call data_.Rows(row_).Delete +End Function + +Public Function FindTaskID(sID$) As Boolean + If sID = "" Then _ + Exit Function + Dim iFound As Excel.Range: + Set iFound = data_.Columns(S_C_TASK_ID).Find(sID, LookAt:=xlWhole) + FindTaskID = Not iFound Is Nothing + If FindTaskID Then _ + row_ = iFound.Row +End Function + +Public Function FindContentName(sName$, sType$) As Boolean + If sName = "" Then _ + Exit Function + Dim iFound As Excel.Range: + Set iFound = data_.Columns(S_C_CONTENT_NAME).Find(sName, LookAt:=xlWhole) + If iFound Is Nothing Then _ + Exit Function + If data_.Cells(iFound.Row, S_C_TASK_TYPE) <> sType Then _ + Exit Function + row_ = iFound.Row + FindContentName = True +End Function + +Public Function SyncCSVTasks(iInput As IteratorCSVTasks) + TaskType = iInput.TaskType + Status = iInput.Status + ContentName = iInput.ContentName + ContentNameDB = iInput.ContentNameDB + Supervisor = iInput.Supervisor + Executor = iInput.Executor + TargetDate = iInput.TargetDate + TaskID = iInput.TaskID + TaskName = iInput.TaskName + ParentID = iInput.ParentID +End Function + +Public Function SyncCSVContent(iInput As IteratorCSVContent) + Call ValidateValue(S_C_BIBLIO_NAME, iInput.BiblioName) + Call ValidateValue(S_C_CHANGE_SCORE, iInput.ChangeScore) + Call ValidateValue(S_C_DEPARTMENT, iInput.Department) + Call ValidateValue(S_C_RESPONSIBLE, iInput.Responsible) + Call ValidateValue(S_C_EDITOR, iInput.Editor) + Call ValidateValue(S_C_DEFINITION, iInput.Definition) + Call ValidateValue(S_C_OBJECT_TYPE, iInput.ObjectType) + Call ValidateListValue(S_C_MARKERS, iInput.Markers) + Call ValidateListValue(S_C_TAGS, iInput.Tags) + Call ValidateValue(S_C_SOURCE, iInput.Source) + Call ValidateValue(S_C_ELECTRON_BRE, iInput.ElectronBre) + Call ValidateValue(S_C_MAIN_PAGE, iInput.MainPage) + Call ValidateValue(S_C_IS_GENERAL, iInput.IsGeneral) + Call ValidateValue(S_C_ACTUALIZE_PERIOD, iInput.ActualizePeriod) + Call ValidateValue(S_C_AGE_RESTRICTION, iInput.AgeRestriction) + Call ValidateValue(S_C_AUTHOR, iInput.Author) + If UpdateStatus = T_UPD_ONCE Then _ + UpdateStatus = T_UPD_UNDEF + Call RecalculateStatus +End Function + +Public Function SyncContent(iInput As IteratorContent) + TaskType = iInput.TaskType + Status = iInput.Status + ContentName = iInput.ContentName + Supervisor = iInput.Supervisor + Executor = iInput.Executor + TargetDate = iInput.TargetDate + + IsImmutable = iInput.IsImmutable + IsMain = iInput.IsMain + IsGeneral = iInput.IsGeneral + IsBRE = iInput.IsBRE + + UpdateStatus = iInput.UpdateStatus + If iInput.BiblioName <> "" Then BiblioName = iInput.BiblioName + If iInput.ChangeScore <> "" Then ChangeScore = iInput.ChangeScore + If iInput.Definition <> "" Then Definition = iInput.Definition + If iInput.ObjectType <> "" Then ObjectType = iInput.ObjectType + If iInput.Markers <> "" Then Markers = iInput.Markers + If iInput.Author <> "" Then Author = iInput.Author + If iInput.Tags <> "" Then Tags = iInput.Tags + If iInput.Editor <> "" Then Editor = iInput.Editor + If iInput.Responsible <> "" Then Responsible = iInput.Responsible + If iInput.Department <> "" Then Department = iInput.Department + If iInput.Source <> "" Then Source = iInput.Source + If iInput.ActualizePeriod <> "" Then ActualizePeriod = iInput.ActualizePeriod + If iInput.AgeRestriction <> "" Then AgeRestriction = iInput.AgeRestriction + If iInput.Priority <> "" Then Priority = iInput.Priority + If iInput.ArticleType <> "" Then ArticleType = iInput.ArticleType + If iInput.Expert <> "" Then Expert = iInput.Expert + If iInput.Contract <> "" Then Contract = iInput.Contract + If iInput.ContentNameDB <> "" Then ContentNameDB = iInput.ContentNameDB + If iInput.TaskID <> "" Then TaskID = iInput.TaskID + If iInput.TaskName <> "" Then TaskName = iInput.TaskName + If iInput.ParentID <> "" Then ParentID = iInput.ParentID + + Call RecalculateStatus +End Function + +Public Function HasBlanks() As Boolean + HasBlanks = True + + If BiblioName = "" Then _ + Exit Function + If Definition = "" Then _ + Exit Function + If Markers = "" Then _ + Exit Function + If ObjectType = "" Then _ + Exit Function + If Supervisor = "" Then _ + Exit Function + If Editor = "" Then _ + Exit Function + + HasBlanks = False +End Function + +Public Function IsIgnored() As Boolean + Dim oldStatus As TUpdateStatus: oldStatus = UpdateStatus + IsIgnored = oldStatus = T_UPD_COMPLETE Or oldStatus = T_UPD_IGNORE +End Function + +Public Function NeedsUpdate() As Boolean + Dim oldStatus As TUpdateStatus: oldStatus = UpdateStatus + NeedsUpdate = oldStatus = T_UPD_AUTO Or oldStatus = T_UPD_ONCE Or oldStatus = T_UPD_ALWAYS +End Function + +Public Function RecalculateStatus() As TUpdateStatus + Dim oldStatus As TUpdateStatus: oldStatus = UpdateStatus + RecalculateStatus = oldStatus + If oldStatus = T_UPD_ONCE Or oldStatus = T_UPD_ALWAYS Or oldStatus = T_UPD_IGNORE Then _ + Exit Function + If TaskID = "" Then + UpdateStatus = T_UPD_UNDEF + ElseIf ContentNameDB = " " Or Status = "" Then + UpdateStatus = T_UPD_UNDEF + ElseIf HasBlanks Then + UpdateStatus = T_UPD_AUTO + Else + UpdateStatus = T_UPD_COMPLETE + End If + RecalculateStatus = UpdateStatus +End Function + +' ======== Property Get ========= +Public Property Get TaskType() As String + TaskType = data_.Cells(row_, S_C_TASK_TYPE) +End Property + +Public Property Get Status() As String + Status = data_.Cells(row_, S_C_STATUS) +End Property + +Public Property Get ContentName() As String + ContentName = data_.Cells(row_, S_C_CONTENT_NAME) +End Property + +Public Property Get UpdateStatus() As TUpdateStatus + UpdateStatus = UpdateStatusFromText(data_.Cells(row_, S_C_UPDATE_STATUS)) +End Property + +Public Property Get ChangeScore() As String + ChangeScore = data_.Cells(row_, S_C_CHANGE_SCORE) +End Property + +Public Property Get BiblioName() As String + BiblioName = data_.Cells(row_, S_C_BIBLIO_NAME) +End Property + +Public Property Get Definition() As String + Definition = data_.Cells(row_, S_C_DEFINITION) +End Property + +Public Property Get IsImmutable() As Boolean + IsImmutable = data_.Cells(row_, S_C_IS_IMMUTABLE) = BOOL_TEXT_YES +End Property + +Public Property Get ObjectType() As String + ObjectType = data_.Cells(row_, S_C_OBJECT_TYPE) +End Property + +Public Property Get Markers() As String + Markers = data_.Cells(row_, S_C_MARKERS) +End Property + +Public Property Get Tags() As String + Tags = data_.Cells(row_, S_C_TAGS) +End Property + +Public Property Get Author() As String + Author = data_.Cells(row_, S_C_AUTHOR) +End Property + +Public Property Get Supervisor() As String + Supervisor = data_.Cells(row_, S_C_SUPERVISOR) +End Property + +Public Property Get Executor() As String + Executor = data_.Cells(row_, S_C_EXECUTOR) +End Property + +Public Property Get Editor() As String + Editor = data_.Cells(row_, S_C_EDITOR) +End Property + +Public Property Get Responsible() As String + Responsible = data_.Cells(row_, S_C_RESPONSIBLE) +End Property + +Public Property Get Department() As String + Department = data_.Cells(row_, S_C_DEPARTMENT) +End Property + +Public Property Get TargetDate() As String + TargetDate = data_.Cells(row_, S_C_TARGET_DATE) +End Property + +Public Property Get Source() As String + Source = data_.Cells(row_, S_C_SOURCE) +End Property + +Public Property Get IsBRE() As Boolean + IsBRE = data_.Cells(row_, S_C_ELECTRON_BRE) = BOOL_TEXT_YES +End Property + +Public Property Get IsMain() As Boolean + IsMain = data_.Cells(row_, S_C_MAIN_PAGE) = BOOL_TEXT_YES +End Property + +Public Property Get IsGeneral() As Boolean + IsGeneral = data_.Cells(row_, S_C_IS_GENERAL) = BOOL_TEXT_YES +End Property + +Public Property Get ActualizePeriod() As String + ActualizePeriod = data_.Cells(row_, S_C_ACTUALIZE_PERIOD) +End Property + +Public Property Get AgeRestriction() As String + AgeRestriction = data_.Cells(row_, S_C_AGE_RESTRICTION) +End Property + +Public Property Get Priority() As String + Priority = data_.Cells(row_, S_C_PRIORITY) +End Property + +Public Property Get ArticleType() As String + ArticleType = data_.Cells(row_, S_C_ARTICLE_TYPE) +End Property + +Public Property Get DateExchange() As String + DateExchange = data_.Cells(row_, S_C_DATE_EXCHANGE) +End Property + +Public Property Get DateEES1() As String + DateEES1 = data_.Cells(row_, S_C_DATE_EES1) +End Property + +Public Property Get DateTools() As String + DateTools = data_.Cells(row_, S_C_DATE_EX_TOOLS) +End Property + +Public Property Get DateEES2() As String + DateEES2 = data_.Cells(row_, S_C_DATE_EES2) +End Property + +Public Property Get Expert() As String + Expert = data_.Cells(row_, S_C_EXPERT) +End Property + +Public Property Get Contract() As String + Contract = data_.Cells(row_, S_C_CONTRACT) +End Property + +Public Property Get Comment() As String + Comment = data_.Cells(row_, S_C_COMMENT) +End Property + +Public Property Get TaskID() As String + TaskID = data_.Cells(row_, S_C_TASK_ID) +End Property + +Public Property Get ContentNameDB() As String + ContentNameDB = data_.Cells(row_, S_C_CONTENT_NAME_DB) +End Property + +Public Property Get TaskName() As String + TaskName = data_.Cells(row_, S_C_TASK_NAME) +End Property + +Public Property Get ParentID() As String + ParentID = data_.Cells(row_, S_C_PARENT_ID) +End Property + +' ==== Property Let ==== +Public Property Let TaskID(newVal$) + Dim oldVal$: oldVal = data_.Cells(row_, S_C_TASK_ID) + data_.Cells(row_, S_C_TASK_ID) = newVal + If newVal <> "" And (oldVal <> newVal Or data_.Cells(row_, S_C_TASK_TYPE).Hyperlinks.Count = 0) Then + Call XLUpdateHyperlink(data_.Cells(row_, S_C_TASK_TYPE), URL_PREFIX_TASK & newVal) + If HasContent Then + Call XLUpdateHyperlink(data_.Cells(row_, S_C_CONTENT_NAME), URL_PREFIX_CONTENT & newVal) + Else + Call data_.Cells(row_, S_C_CONTENT_NAME).Hyperlinks.Delete + End If + End If +End Property + +Public Property Let TaskType(newVal$) + data_.Cells(row_, S_C_TASK_TYPE) = newVal +End Property + +Public Property Let Status(newVal$) + data_.Cells(row_, S_C_STATUS) = newVal +End Property + +Public Property Let ContentName(newVal$) + data_.Cells(row_, S_C_CONTENT_NAME) = newVal +End Property + +Public Property Let UpdateStatus(newVal As TUpdateStatus) + data_.Cells(row_, S_C_UPDATE_STATUS) = UpdateStatusToText(newVal) +End Property + +Public Property Let ChangeScore(newVal$) + data_.Cells(row_, S_C_CHANGE_SCORE) = newVal +End Property + +Public Property Let BiblioName(newVal$) + data_.Cells(row_, S_C_BIBLIO_NAME) = newVal +End Property + +Public Property Let Definition(newVal$) + data_.Cells(row_, S_C_DEFINITION) = newVal +End Property + +Public Property Let IsImmutable(newVal As Boolean) + data_.Cells(row_, S_C_IS_IMMUTABLE) = IIf(newVal, BOOL_TEXT_YES, BOOL_TEXT_NO) +End Property + +Public Property Let ObjectType(newVal$) + data_.Cells(row_, S_C_OBJECT_TYPE) = newVal +End Property + +Public Property Let Markers(newVal$) + data_.Cells(row_, S_C_MARKERS) = newVal +End Property + +Public Property Let Tags(newVal$) + data_.Cells(row_, S_C_TAGS) = newVal +End Property + +Public Property Let Author(newVal$) + data_.Cells(row_, S_C_AUTHOR) = newVal +End Property + +Public Property Let Supervisor(newVal$) + data_.Cells(row_, S_C_SUPERVISOR) = newVal +End Property + +Public Property Let Executor(newVal$) + data_.Cells(row_, S_C_EXECUTOR) = newVal +End Property + +Public Property Let Editor(newVal$) + data_.Cells(row_, S_C_EDITOR) = newVal +End Property + +Public Property Let Responsible(newVal$) + data_.Cells(row_, S_C_RESPONSIBLE) = newVal +End Property + +Public Property Let Department(newVal$) + data_.Cells(row_, S_C_DEPARTMENT) = newVal +End Property + +Public Property Let TargetDate(newVal$) + data_.Cells(row_, S_C_TARGET_DATE) = newVal +End Property + +Public Property Let Source(newVal$) + data_.Cells(row_, S_C_SOURCE) = newVal +End Property + +Public Property Let IsBRE(newVal As Boolean) + data_.Cells(row_, S_C_ELECTRON_BRE) = IIf(newVal, BOOL_TEXT_YES, BOOL_TEXT_NO) +End Property + +Public Property Let IsMain(newVal As Boolean) + data_.Cells(row_, S_C_MAIN_PAGE) = IIf(newVal, BOOL_TEXT_YES, BOOL_TEXT_NO) +End Property + +Public Property Let IsGeneral(newVal As Boolean) + data_.Cells(row_, S_C_IS_GENERAL) = IIf(newVal, BOOL_TEXT_YES, BOOL_TEXT_NO) +End Property + +Public Property Let ActualizePeriod(newVal$) + data_.Cells(row_, S_C_ACTUALIZE_PERIOD) = newVal +End Property + +Public Property Let AgeRestriction(newVal$) + data_.Cells(row_, S_C_AGE_RESTRICTION) = newVal +End Property + +Public Property Let Priority(newVal$) + data_.Cells(row_, S_C_PRIORITY) = newVal +End Property + +Public Property Let ArticleType(newVal$) + data_.Cells(row_, S_C_ARTICLE_TYPE) = newVal +End Property + +Public Property Let DateExchange(newVal$) + data_.Cells(row_, S_C_DATE_EXCHANGE) = newVal +End Property + +Public Property Let DateEES1(newVal$) + data_.Cells(row_, S_C_DATE_EES1) = newVal +End Property + +Public Property Let DateTools(newVal$) + data_.Cells(row_, S_C_DATE_EX_TOOLS) = newVal +End Property + +Public Property Let DateEES2(newVal$) + data_.Cells(row_, S_C_DATE_EES2) = newVal +End Property + +Public Property Let Expert(newVal$) + data_.Cells(row_, S_C_EXPERT) = newVal +End Property + +Public Property Let Contract(newVal$) + data_.Cells(row_, S_C_CONTRACT) = newVal +End Property + +Public Property Let ContentNameDB(newVal$) + data_.Cells(row_, S_C_CONTENT_NAME_DB) = newVal +End Property + +Public Property Let TaskName(newVal$) + data_.Cells(row_, S_C_TASK_NAME) = newVal + If data_.Cells(row_, S_C_IS_IMMUTABLE) = "" Then + If newVal Like " *" Then + data_.Cells(row_, S_C_IS_IMMUTABLE) = BOOL_TEXT_YES + Else + data_.Cells(row_, S_C_IS_IMMUTABLE) = BOOL_TEXT_NO + End If + End If +End Property + +Public Property Let ParentID(newVal$) + data_.Cells(row_, S_C_PARENT_ID) = newVal +End Property + +' ======= +Private Function GetLastRow() As Long + GetLastRow = data_.Cells(data_.Rows.Count, 1).End(xlUp).Row +End Function + +Private Function ColorCell(nColumn&, nColor&) + data_.Cells(row_, nColumn).Interior.Color = nColor +End Function + +Private Function ValidateValue(nColumn&, portalValue$) + Dim sValue$: sValue = data_.Cells(row_, nColumn) + If sValue = portalValue Then _ + Exit Function + + If sValue = "" Then + data_.Cells(row_, nColumn) = portalValue + Exit Function + End If + + If portalValue = "" Then + Call ColorCell(nColumn, RGB(142, 169, 219)) + Else + Call ColorCell(nColumn, RGB(255, 151, 151)) + End If +End Function + +Private Function ValidateListValue(nColumn&, portalValue$) + Dim sValue$: sValue = data_.Cells(row_, nColumn) + If CheckListsEqual(sValue, portalValue) Then _ + Exit Function + + If sValue = "" Then + data_.Cells(row_, nColumn) = portalValue + Exit Function + End If + + If portalValue = "" Then + Call ColorCell(nColumn, RGB(142, 169, 219)) + Else + Call ColorCell(nColumn, RGB(255, 151, 151)) + End If +End Function diff --git a/src/Main.bas b/src/Main.bas new file mode 100644 index 0000000..b366fc5 --- /dev/null +++ b/src/Main.bas @@ -0,0 +1,152 @@ +Attribute VB_Name = "Main" +Option Explicit + +Public Sub RunImportCSV() + Dim sFile$: sFile = UserInteraction.PromptFileFilter(ThisWorkbook.Path, _ + sDescription:=" CSV", _ + sFilter:="*.csv") + If sFile = vbNullString Then _ + Exit Sub + If Not ProcessCSV(sFile) Then _ + Exit Sub + Call UserInteraction.ShowMessage(IM_IMPORT_SUCCESS) +End Sub + +Public Sub RunImportDB() + Dim sFile$: sFile = UserInteraction.PromptFileFilter(ThisWorkbook.Path, _ + sDescription:=" Excel", _ + sFilter:="*.xlsx;*.xls;*.xlsm") + If sFile = vbNullString Then _ + Exit Sub + + Dim xlInput As New API_XLWrapper: Call xlInput.SetApplication(ThisWorkbook.Application) + If xlInput.OpenDocument(sFile, bReadOnly:=True) Is Nothing Then + Call UserInteraction.ShowMessage(EM_FILE_CANNOT_OPEN, sFile) + Exit Sub + End If + + Call xlInput.PauseUI + + Dim iInput As New DB_Content: Call iInput.Init(xlInput.Document.Sheets(SHEET_CONTENT), xlInput.Document.Worksheets(SHEET_ATTRIBUTES)) + Call ImportDataFromDB(iInput, AccessContent) + + Call xlInput.ResumeUI + Call xlInput.ReleaseDocument + Call UserInteraction.ShowMessage(IM_IMPORT_SUCCESS) +End Sub + +Public Sub RunEditConfig() + Call ThisWorkbook.Worksheets(SHEET_CONFIG).Activate +End Sub + +Public Sub RunUpdateTasks() + Dim iConfig As InfoConfig: Set iConfig = AccessConfig + Call iConfig.SetScanTasks(True) + Call iConfig.SetScanContent(False) + Call ExecuteUpdateRequest(iConfig) +End Sub + +Public Sub RunUpdateContent() + Dim iConfig As InfoConfig: Set iConfig = AccessConfig + Call iConfig.SetScanTasks(False) + Call iConfig.SetScanContent(True) + Call ExecuteUpdateRequest(iConfig) +End Sub + +Public Sub RunUpdatePortal() + Dim iConfig As InfoConfig: Set iConfig = AccessConfig + Call iConfig.SetScanTasks(True) + Call iConfig.SetScanContent(True) + Call ExecuteUpdateRequest(iConfig) +End Sub + +Public Sub RunClearData() + Call ClearData + Call UserInteraction.ShowMessage(IM_DATA_DELETED) +End Sub + +Public Sub RunUnstuck() + Dim uiWrap As New API_XLWrapper: Call uiWrap.SetDocument(ThisWorkbook) + Call uiWrap.ResumeUI +End Sub + +Public Sub RunInputMarks() + Dim iTarget As Excel.Range: Set iTarget = Excel.Selection.Cells(1, 1) + Call CSE_ListSelector.Init(ThisWorkbook.Worksheets(SHEET_OPTIONS).ListObjects(TABLE_MARKERS)) + Call CSE_ListSelector.Show + If CSE_ListSelector.isCanceled_ Then _ + Exit Sub + + iTarget = CSE_ListSelector.GetSelectedStr + Call Unload(CSE_ListSelector) +End Sub + +Public Sub RunInputTags() +Dim iTarget As Excel.Range: Set iTarget = Excel.Selection.Cells(1, 1) + Call CSE_ListSelector.Init(ThisWorkbook.Worksheets(SHEET_OPTIONS).ListObjects(TABLE_TAGS)) + Call CSE_ListSelector.Show + If CSE_ListSelector.isCanceled_ Then _ + Exit Sub + + iTarget = CSE_ListSelector.GetSelectedStr + Call Unload(CSE_ListSelector) +End Sub + +' ======= +Private Function ProcessCSV(sFile$) As Boolean + ProcessCSV = False + + Dim dataIn As Excel.Worksheet: Set dataIn = ThisWorkbook.Worksheets.Add + With dataIn.QueryTables.Add(Connection:="TEXT;" & sFile, Destination:=dataIn.Cells(1, 1)) + .TextFileParseType = xlDelimited + .TextFileCommaDelimiter = True + .TextFilePlatform = 65001 ' UTF-8 + .Refresh + End With + + Dim sID$: sID = dataIn.Cells(1, 1) + If sID <> "" Then + If VBA.Left(sID, 1) Like "[0-9a-f]" Then + Dim iContent As New IteratorCSVContent: Call iContent.Init(dataIn) + Call ImportContentFromCSV(iContent, AccessContent) + Else + Dim iTasks As New IteratorCSVTasks: Call iTasks.Init(dataIn, AccessWorkers) + Call ImportTasksFromCSV(iTasks, AccessContent) + End If + End If + + + Dim bAlerts As Boolean: bAlerts = Excel.Application.DisplayAlerts + Excel.Application.DisplayAlerts = False + Call dataIn.QueryTables(1).Delete + Call dataIn.Delete + Excel.Application.DisplayAlerts = bAlerts + + ProcessCSV = True +End Function + +Private Function ExecuteUpdateRequest(iConfig As InfoConfig) + Call iConfig.CreateConfigFile + + Dim bScanPortal As Boolean: bScanPortal = PortalUpdate(iConfig) + ' Call iConfig.DeleteConfigFile + If Not bScanPortal Then _ + Exit Function + + Dim bProcessTasks As Boolean: bProcessTasks = True + If iConfig.ScanTasks Then + Dim sFile$: sFile = iConfig.OutputFileTasks + bProcessTasks = ProcessCSV(sFile) + ' Call Kill(sFile) + End If + + Dim bProcessContent As Boolean: bProcessContent = True + If iConfig.ScanContent Then + sFile = iConfig.OutputFileContent + bProcessContent = ProcessCSV(sFile) + ' Call Kill(sFile) + End If + + If bProcessTasks And bProcessContent Then _ + Call UserInteraction.ShowMessage(IM_IMPORT_SUCCESS) +End Function diff --git a/src/MainImpl.bas b/src/MainImpl.bas new file mode 100644 index 0000000..c5af364 --- /dev/null +++ b/src/MainImpl.bas @@ -0,0 +1,143 @@ +Attribute VB_Name = "MainImpl" +Option Private Module +Option Explicit + +Public Function AccessContent() As DB_Content + Static s_Content As DB_Content + + If s_Content Is Nothing Then + Set s_Content = New DB_Content + Call s_Content.Init(ThisWorkbook.Worksheets(SHEET_CONTENT), ThisWorkbook.Worksheets(SHEET_ATTRIBUTES)) + End If + + Set AccessContent = s_Content +End Function + +Public Function AccessWorkers() As DB_Workers + Static s_Workerks As DB_Workers + + If s_Workerks Is Nothing Then + Set s_Workerks = New DB_Workers + Call s_Workerks.Init(ThisWorkbook.Worksheets(SHEET_OPTIONS).ListObjects(TABLE_WORKERS)) + End If + + Set AccessWorkers = s_Workerks +End Function + +Public Function AccessConfig() As InfoConfig + Set AccessConfig = New InfoConfig + Call AccessConfig.Init(ThisWorkbook.Worksheets(SHEET_CONFIG), AccessContent) +End Function + +Public Function ClearData() + Call XLShowAllData(ThisWorkbook.Sheets(SHEET_CONTENT)) + Call ThisWorkbook.Sheets(SHEET_CONTENT).UsedRange.Offset(1, 0).Rows.EntireRow.Delete + + Call XLShowAllData(ThisWorkbook.Sheets(SHEET_ATTRIBUTES)) + Call ThisWorkbook.Sheets(SHEET_ATTRIBUTES).UsedRange.Offset(1, 0).Rows.EntireRow.Delete +End Function + +Public Function ImportTasksFromCSV(iInput As IteratorCSVTasks, iOutput As DB_Content) + Call CSE_ProgressBar.Init(" CSV", maxVal:=iInput.CountRows) + Call CSE_ProgressBar.ShowModeless + + Call iOutput.EnsureDataVisible + Call iOutput.ImportCSVTasks(iInput) + + Call Unload(CSE_ProgressBar) +End Function + +Public Function ImportContentFromCSV(iInput As IteratorCSVContent, iOutput As DB_Content) + Call CSE_ProgressBar.Init(" CSV", maxVal:=iInput.CountRows) + Call CSE_ProgressBar.ShowModeless + + Call iOutput.EnsureDataVisible + Call iOutput.ImportCSVContent(iInput) + + Call Unload(CSE_ProgressBar) +End Function + +Public Function ImportDataFromDB(iInput As DB_Content, iOutput As DB_Content) + Call CSE_ProgressBar.Init(" ", maxVal:=iInput.Count) + Call CSE_ProgressBar.ShowModeless + + Call iInput.EnsureDataVisible + Call iOutput.EnsureDataVisible + Call iOutput.ImportDB(iInput) + + Call Unload(CSE_ProgressBar) +End Function + +Public Function PortalUpdate(iConfig As InfoConfig) As Boolean + PortalUpdate = False + Dim sExec$: sExec = EXPORTER_EXECUTABLE & " " & EXPORTER_CONFIG_FILE + Dim fso As New Scripting.FileSystemObject + If Not fso.FileExists(ThisWorkbook.Path & "\" & EXPORTER_EXECUTABLE) Then + Call UserInteraction.ShowMessage(EM_MISSING_EXEC, EXPORTER_EXECUTABLE) + Exit Function + End If + + Dim iShell As New WshShell + iShell.CurrentDirectory = ThisWorkbook.Path + On Error GoTo REPORT_EXEC + If iShell.Run(sExec, WaitOnReturn:=True) <> 0 Then +REPORT_EXEC: + Call UserInteraction.ShowMessage(EM_CANNOT_EXEC, sExec) + Exit Function + End If + On Error GoTo 0 + + Dim sOutput1$: sOutput1 = iConfig.OutputFileTasks + If Not fso.FileExists(sOutput1) Then + Call UserInteraction.ShowMessage(EM_MISSING_FILE, sExec) + Exit Function + End If + + Dim sOutput2$: sOutput2 = iConfig.OutputFileContent + If iConfig.ScanContent And Not fso.FileExists(sOutput2) Then + Call UserInteraction.ShowMessage(EM_MISSING_FILE, sExec) + Exit Function + End If + PortalUpdate = True +End Function + +Public Function CheckListsEqual(list1$, list2$) As Boolean + CheckListsEqual = False + Dim items1 As Variant: items1 = VBA.Split(list1, ";") + Dim items2 As Variant: items2 = VBA.Split(list2, ";") + If UBound(items1) <> UBound(items2) Then _ + Exit Function + + Dim it1 As Variant + Dim it2 As Variant + Dim flagExists As Boolean + For Each it1 In items1 + flagExists = False + + For Each it2 In items2 + If it1 = it2 Then + flagExists = True + Exit For + End If + Next it2 + + If Not flagExists Then _ + Exit Function + Next it1 + + For Each it2 In items2 + flagExists = False + + For Each it1 In items1 + If it1 = it2 Then + flagExists = True + Exit For + End If + Next it1 + + If Not flagExists Then _ + Exit Function + Next it2 + + CheckListsEqual = True +End Function diff --git a/src/z_UIMessages.bas b/src/z_UIMessages.bas new file mode 100644 index 0000000..f1e94a3 --- /dev/null +++ b/src/z_UIMessages.bas @@ -0,0 +1,61 @@ +Attribute VB_Name = "z_UIMessages" +' +Option Explicit + +Public Enum MsgCode + MSG_OK = 0 + + EM_FILE_CANNOT_OPEN + EM_CANNOT_EXEC + EM_MISSING_FILE + EM_ITEM_EXISTS + EM_MISSING_EXEC + + IM_IMPORT_SUCCESS + IM_DATA_DELETED + + ' QM_MERGE_WARNING +End Enum + +Private g_UI As API_UserInteraction + +Public Function UserInteraction() As API_UserInteraction + If g_UI Is Nothing Then _ + Set g_UI = New API_UserInteraction + Set UserInteraction = g_UI +End Function + +Public Function SetUserInteraction(newUI As API_UserInteraction) + Set g_UI = newUI +End Function + +Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant) + Dim unwrapped As Variant: unwrapped = params + unwrapped = FixForwardedParams(unwrapped) + + Select Case theCode + Case EM_FILE_CANNOT_OPEN: Call MsgBox(Fmt(" {1}", unwrapped), vbExclamation) + Case EM_CANNOT_EXEC: Call MsgBox(Fmt(" " & vbNewLine & """{1}""", unwrapped), vbExclamation) + Case EM_MISSING_FILE: Call MsgBox(Fmt(" {1}", unwrapped), vbExclamation) + Case EM_ITEM_EXISTS: Call MsgBox(Fmt(" : {1}", unwrapped), vbExclamation) + Case EM_MISSING_EXEC: Call MsgBox(Fmt(" Python: {1}", unwrapped), vbExclamation) + + Case IM_IMPORT_SUCCESS: Call MsgBox(" ", vbInformation) + Case IM_DATA_DELETED: Call MsgBox(" ", vbInformation) + + Case Else: Call MsgBox(" ", vbCritical) + End Select +End Function + +Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean + Dim unwrapped As Variant: unwrapped = params + unwrapped = FixForwardedParams(unwrapped) + + Dim answer&: answer = vbNo + Select Case theCode + ' Case QM_DELETE_LAW: answer = MsgBox(Fmt("! {1} !" & vbNewLine & "?", unwrapped), vbYesNo + vbQuestion) + + Case Else: Call MsgBox(" ", vbCritical) + End Select + UIAskQuestion = answer = vbYes +End Function diff --git a/src/z_UIRibbon.bas b/src/z_UIRibbon.bas new file mode 100644 index 0000000..4c1a76f --- /dev/null +++ b/src/z_UIRibbon.bas @@ -0,0 +1,20 @@ +Attribute VB_Name = "z_UIRibbon" +Option Explicit + +Public Sub OnRibbonBtn(iControl As IRibbonControl) + Select Case iControl.ID + Case "ImportCSV": Call RunImportCSV + Case "ImportDB": Call RunImportDB + + Case "EditConfig": Call RunEditConfig + Case "UpdateTasks": Call RunUpdateTasks + Case "UpdateContent": Call RunUpdateContent + Case "UpdatePortal": Call RunUpdatePortal + + Case "InputMarks": Call RunInputMarks + Case "InputTags": Call RunInputTags + + Case "Unstuck": Call RunUnstuck + Case "ClearData": Call RunClearData + End Select +End Sub diff --git a/ui/.rels b/ui/.rels new file mode 100644 index 0000000..3107a8e --- /dev/null +++ b/ui/.rels @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/ui/customUI.xml b/ui/customUI.xml new file mode 100644 index 0000000..12ec4bc --- /dev/null +++ b/ui/customUI.xml @@ -0,0 +1,66 @@ + + + + + + +