commit 3313a8fb89c63ffea2c1b9f6b63e0d85561e9a47 Author: IRBorisov <8611739+IRBorisov@users.noreply.github.com> Date: Fri Jun 7 20:14:51 2024 +0300 Initial commit diff --git a/VBAMake.txt b/VBAMake.txt new file mode 100644 index 0000000..5dfc8e9 --- /dev/null +++ b/VBAMake.txt @@ -0,0 +1,31 @@ +# == Properties Section == +# configuration properties +# use .ini format to define properties +# mandatory properties: name, artifact_home, source_home + +id = Concept-Tasks +name = Концепт-Задачи +description = Технология управления решениями и задачами +artifact_home = Концепт-Задачи +source_home = Concept-Tasks +install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\01 Высокие технологии\Концепт-Задачи + +%% +# === Build section === +# Available commands: +# build LOCAL_MANIFEST +# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT] +# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT +# run LOCAL_SOURCE.bat + +build script\decisionsManagement.txt + +%% +# === 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/decisionsManagement.txt b/script/decisionsManagement.txt new file mode 100644 index 0000000..9702612 --- /dev/null +++ b/script/decisionsManagement.txt @@ -0,0 +1,60 @@ +# == 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 + +dev + DevTester.bas + +api + API_WordWrapper.cls + API_XLWrapper.cls + +utility + ex_DataPreparation.bas + ex_VBA.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 + DataAccess.bas + Main.bas + MainImpl.bas + + FileScaner.cls + s_DataAccess.cls + s_FileScaner.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 + + + +%% +# === References Section === +# List dependencies in one of the formats +# global : GLOBAL_NAME +# guid : {REGISTERED_GUID} +# file : PATH_TO_LIBRARY + +global : Scripting +global : Word +global : MSForms \ No newline at end of file diff --git a/skeleton/!Управление решениями.xlsm b/skeleton/!Управление решениями.xlsm new file mode 100644 index 0000000..e223673 Binary files /dev/null and b/skeleton/!Управление решениями.xlsm differ diff --git a/src/DataAccess.bas b/src/DataAccess.bas new file mode 100644 index 0000000..223ea3e --- /dev/null +++ b/src/DataAccess.bas @@ -0,0 +1,62 @@ +Attribute VB_Name = "DataAccess" +Option Private Module +Option Explicit + +Public Function Sources() As Scripting.Dictionary + Set Sources = New Scripting.Dictionary + Dim wData As Excel.Worksheet: Set wData = ThisWorkbook.Sheets(SHEET_SOURCES) + Dim nRow&: nRow = FIRST_ROW + Do While wData.Cells(nRow, S_SRC_ID) <> vbNullString + Dim sFile$: sFile = wData.Cells(nRow, S_SRC_FILE).Text + If Not Sources.Exists(sFile) Then _ + Call Sources.Add(sFile, wData.Cells(nRow, S_SRC_ID)) + nRow = nRow + 1 + Loop +End Function + +Public Function SourceLocations() As Collection + Set SourceLocations = New Collection + + Dim tData As Excel.ListObject: Set tData = ThisWorkbook.Worksheets(SHEET_PARAMS).ListObjects(TABLE_SOURCE_LOCATIONS) + Dim dataRng As Excel.Range: Set dataRng = tData.Range + Dim nRow&: nRow = FIRST_ROW + For nRow = FIRST_ROW To dataRng.Rows.Count Step 1 + If dataRng.Cells(nRow, 1) <> vbNullString Then _ + Call SourceLocations.Add(dataRng.Cells(nRow, 1).Text) + Next nRow +End Function + +Public Function AddSource(sProject$, sFile$) As Long + If sFile = vbNullString Then _ + Exit Function + + Dim wData As Excel.Worksheet: Set wData = ThisWorkbook.Sheets(SHEET_SOURCES) + Dim nRow&: nRow = FIRST_ROW + Do While wData.Cells(nRow, S_SRC_ID) <> vbNullString + nRow = nRow + 1 + Loop + AddSource = Application.WorksheetFunction.Max(wData.Columns(S_SRC_ID)) + 1 + wData.Cells(nRow, S_SRC_ID) = AddSource + wData.Cells(nRow, S_SRC_PROJECT) = sProject + wData.Cells(nRow, S_SRC_FILE) = sFile + Dim hRange As Excel.Range: Set hRange = wData.Cells(nRow, S_SRC_FILE) + Call hRange.Hyperlinks.Add(hRange, sFile) +End Function + +Public Function AddTask(dDate As Double, sProject$, sText$, sResponsible$, nSource&, sFile$) As Long + Dim wData As Excel.Worksheet: Set wData = ThisWorkbook.Sheets(SHEET_TASKS) + Dim nRow&: nRow = FIRST_ROW + Call wData.Rows(nRow).EntireRow.Insert(Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow) + + AddTask = Application.WorksheetFunction.Max(wData.Columns(S_TASK_ID)) + 1 + wData.Cells(nRow, S_TASK_ID) = AddTask + wData.Cells(nRow, S_TASK_STATUS) = T_TT_OPEN + wData.Cells(nRow, S_TASK_PROJECT) = sProject + wData.Cells(nRow, S_TASK_TEXT) = sText + wData.Cells(nRow, S_TASK_RESPONSIBLE) = sResponsible + wData.Cells(nRow, S_TASK_SOURCE_ID) = nSource + wData.Cells(nRow, S_TASK_DATE) = IIf(dDate = 0, "", dDate) + + Dim hRange As Excel.Range: Set hRange = wData.Cells(nRow, S_TASK_SOURCE_ID) + Call hRange.Hyperlinks.Add(hRange, sFile) +End Function diff --git a/src/Declarations.bas b/src/Declarations.bas new file mode 100644 index 0000000..dddea88 --- /dev/null +++ b/src/Declarations.bas @@ -0,0 +1,47 @@ +Attribute VB_Name = "Declarations" +Option Private Module +Option Explicit + +Public Const SHEET_SOURCES = "" +Public Const SHEET_TASKS = "" +Public Const SHEET_PARAMS = "" + +Public Const TABLE_SOURCE_LOCATIONS = "t_SourceLocations" +Public Const TABLE_STATUSES = "t_Status" + +Public Const WORD_MASK = "*.doc*" + +Public Const FIRST_ROW = 2 + +' Task type +Public Enum TTaskType + T_TT_OPEN = 0 + T_TT_CLOSED = 1 + T_TT_CANCELED = 2 +End Enum + +' _SRC_ - Source structure +Public Enum SourceStruct + [_First] = 1 + + S_SRC_ID = 1 + S_SRC_PROJECT = 2 + S_SRC_FILE = 3 + + [_Last] = 3 +End Enum + +' _TASK_ - Task structure +Public Enum TaskStruct + [_First] = 1 + + S_TASK_ID = 1 + S_TASK_DATE = 2 + S_TASK_PROJECT = 3 + S_TASK_STATUS = 4 + S_TASK_TEXT = 5 + S_TASK_RESPONSIBLE = 6 + S_TASK_SOURCE_ID = 7 + + [_Last] = 7 +End Enum diff --git a/src/DevHelper.bas b/src/DevHelper.bas new file mode 100644 index 0000000..0d43d72 --- /dev/null +++ b/src/DevHelper.bas @@ -0,0 +1,23 @@ +Attribute VB_Name = "DevHelper" +Option Private Module +Option Explicit + +Public Function Dev_PrepareSkeleton() + ' Do nothing + ClearAll +End Function + +Public Function Dev_ManualRunTest() + Dim sSuite$: sSuite = "s_FileScaner" + Dim sTest$: sTest = "t_ScanContents" + Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest) + Debug.Print sMsg + Call MsgBox(sMsg) +End Function + +Public Function Dev_GetTestSuite(sName$) As Object + Select Case sName + Case "s_FileScaner": Set Dev_GetTestSuite = New s_FileScaner + Case "s_DataAccess": Set Dev_GetTestSuite = New s_DataAccess + End Select +End Function diff --git a/src/FileScaner.cls b/src/FileScaner.cls new file mode 100644 index 0000000..b90a84f --- /dev/null +++ b/src/FileScaner.cls @@ -0,0 +1,97 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "FileScaner" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private word_ As API_WordWrapper +Private doc_ As Word.Document + +Public Function Init() + Set word_ = New API_WordWrapper + Call word_.CreateApplication(bIsVisible:=True) +End Function + +Public Function Finalize() + Call word_.ReleaseApplication + Set word_ = Nothing +End Function + +Public Function Process(sFile$) As Long + If word_.OpenDocument(sFile, bReadOnly:=True) Is Nothing Then _ + Exit Function + + Process = ProcessDocument(word_.Document) + + Call word_.ReleaseDocument(bCloseApplication:=False) +End Function + +Public Function ProcessDocument(target As Word.Document) As Long + Set doc_ = target + + Dim sProject$: sProject = ExtractProject + Dim dDate As Double: dDate = ExtractDate + + Dim nSourceID&: nSourceID = AddSource(sProject, doc_.FullName) + ProcessDocument = ProcessTasks(dDate, sProject, nSourceID) + + Set doc_ = Nothing +End Function + +' ======= +Private Function ProcessTasks(dDate As Double, sProject$, nSourceID&) As Long + Dim taskRange As Word.Range: Set taskRange = doc_.Range + With taskRange.Find + .Text = ":" + .MatchCase = True + If Not .Execute Then _ + Exit Function + End With + + taskRange.Start = taskRange.End + 2 + taskRange.End = doc_.Range.End + + Dim aPara As Word.Paragraph + Dim nPara + For nPara = taskRange.Paragraphs.Count To 1 Step -1 + Set aPara = taskRange.Paragraphs(nPara) + Dim sText$: sText = SubstituteWhitespace(aPara.Range.Text) + If sText <> vbNullString Then + If AddTaskInternal(sText, dDate, sProject, nSourceID, doc_.FullName) Then _ + ProcessTasks = ProcessTasks + 1 + End If + Next nPara +End Function + +Private Function AddTaskInternal(ByRef sText$, dDate As Double, sProject$, nSourceID&, sFile$) As Boolean + AddTaskInternal = False + + Dim nDelim&: nDelim = VBA.InStrRev(sText, "@@") + If nDelim = 0 Then _ + Exit Function + + Dim sResponsible$: sResponsible = VBA.Right(sText, VBA.Len(sText) - nDelim - 1) + sText = VBA.Left(sText, VBA.Len(sText) - VBA.Len(sResponsible) - 2) + sText = TrimEndPunctuation(sText) + Call AddTask(dDate, sProject, VBA.Trim(sText), VBA.Trim(sResponsible), nSourceID, sFile) + + AddTaskInternal = True +End Function + +Private Function ExtractProject() As String + On Error Resume Next + ExtractProject = TrimWhitespace(doc_.Tables(1).Cell(1, 3).Range.Text) +End Function + +Private Function ExtractDate() As Double + On Error Resume Next + Dim sDate$: sDate = TrimWhitespace(doc_.Tables(1).Cell(3, 2).Range.Text) + If Len(sDate) <= 2 Then _ + Exit Function + ExtractDate = DateValue(sDate) +End Function diff --git a/src/Main.bas b/src/Main.bas new file mode 100644 index 0000000..158da87 --- /dev/null +++ b/src/Main.bas @@ -0,0 +1,20 @@ +Attribute VB_Name = "Main" +Option Explicit + +Public Sub RunUpdate() + Dim oLocations As Collection: Set oLocations = SourceLocations + Dim knownSources As Scripting.Dictionary: Set knownSources = Sources + + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook) + Call xlUI.PauseUI + + Dim aLocation As Variant + Dim nCount&: nCount = 0 + For Each aLocation In oLocations + nCount = nCount + ImportDataFrom(CStr(aLocation), knownSources) + Next aLocation + + Call xlUI.ResumeUI + + Call MsgBox(Fmt(" : {1}", nCount), vbInformation) +End Sub diff --git a/src/MainImpl.bas b/src/MainImpl.bas new file mode 100644 index 0000000..ad6719e --- /dev/null +++ b/src/MainImpl.bas @@ -0,0 +1,30 @@ +Attribute VB_Name = "MainImpl" +Option Private Module +Option Explicit + +Public Function ClearAll() + Call ThisWorkbook.Sheets(SHEET_SOURCES).UsedRange.Offset(1, 0).ClearContents + Call ThisWorkbook.Sheets(SHEET_TASKS).UsedRange.Offset(1, 0).ClearContents +End Function + +Public Function ImportDataFrom(sFolder$, knownSources As Scripting.Dictionary) As Long + Dim oFiles As Collection: Set oFiles = ListFiles(sFolder, WORD_MASK) + Dim sFile As Variant + Dim iScaner As New FileScaner: Call iScaner.Init + For Each sFile In oFiles + Dim sFullPath$: sFullPath = sFolder & "\" & CStr(sFile) + If Not knownSources.Exists(sFullPath) Then _ + ImportDataFrom = ImportDataFrom + iScaner.Process(sFullPath) + Next sFile + Call iScaner.Finalize +End Function + +' ==== +Private Function ListFiles(sFolder$, sMask$) As Collection + Set ListFiles = New Collection + Dim sFile$: sFile = Dir(sFolder & "\" & sMask) + Do While Len(sFile) > 0 And sFile <> sFolder + Call ListFiles.Add(sFile) + sFile = Dir + Loop +End Function diff --git a/src/s_DataAccess.cls b/src/s_DataAccess.cls new file mode 100644 index 0000000..d95823b --- /dev/null +++ b/src/s_DataAccess.cls @@ -0,0 +1,71 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "s_DataAccess" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Public Function Setup() + ' Mandatory setup function +End Function + +Public Function Teardown() + ' Mandatory teardown function + Call ClearAll +End Function + +Public Function t_Sources() + On Error GoTo PROPAGATE_ERROR + + Call Dev_ExpectEQ(CSet(), Sources(), "Empty data") + Call Dev_ExpectEQ(0, AddSource("proj1", ""), "Empty file") + + Dim iSources As New Scripting.Dictionary + iSources("C:\Windows\file1.docx") = 1 + iSources("invalid path?") = 2 + iSources("C:\Windows\file2.docx") = 3 + + Call Dev_ExpectEQ(1, AddSource("proj1", "C:\Windows\file1.docx"), "Add valid path") + Call Dev_ExpectEQ(2, AddSource("proj1", "invalid path?"), "Add invalid path") + Call Dev_ExpectEQ(3, AddSource("", "C:\Windows\file2.docx"), "Empty project") + Call Dev_ExpectEQ(4, AddSource("proj2", "C:\Windows\file1.docx"), "Duplicate file") + Call Dev_ExpectEQ(iSources, Sources(), "Valid data") + Dim iCell As Excel.Range: Set iCell = ThisWorkbook.Sheets(SHEET_SOURCES).Cells(FIRST_ROW, S_SRC_FILE) + Call Dev_ExpectEQ("C:\Windows\file1.docx", iCell.Hyperlinks(1).Address, "Add hyperlink") + + Call Dev_NewCase("Custom id") + ThisWorkbook.Sheets(SHEET_SOURCES).Cells(FIRST_ROW, S_SRC_ID) = 100 + Call Dev_ExpectEQ(101, AddSource("proj3", "C:\Windows\file6.docx")) + + Exit Function +PROPAGATE_ERROR: + Call Dev_LogError(Err.Number, Err.Description) +End Function + +Public Function t_Tasks() + On Error GoTo PROPAGATE_ERROR + + Dim iTasks As Excel.Worksheet: Set iTasks = ThisWorkbook.Sheets(SHEET_TASKS) + + Call Dev_NewCase("Valid add task") + Call Dev_ExpectEQ(1, AddTask(100, "project", "text", "resp", 1337, "C:\Windows\file1.docx")) + Call Dev_ExpectEQ(1, iTasks.Cells(FIRST_ROW, S_TASK_ID)) + Call Dev_ExpectEQ(100, iTasks.Cells(FIRST_ROW, S_TASK_DATE)) + Call Dev_ExpectEQ(T_TT_OPEN, iTasks.Cells(FIRST_ROW, S_TASK_STATUS)) + Call Dev_ExpectEQ("project", iTasks.Cells(FIRST_ROW, S_TASK_PROJECT)) + Call Dev_ExpectEQ("text", iTasks.Cells(FIRST_ROW, S_TASK_TEXT)) + Call Dev_ExpectEQ("resp", iTasks.Cells(FIRST_ROW, S_TASK_RESPONSIBLE)) + Call Dev_ExpectEQ(1337, iTasks.Cells(FIRST_ROW, S_TASK_SOURCE_ID)) + + Call Dev_NewCase("Insert new to top") + Call Dev_ExpectEQ(2, AddTask(101, "project2", "text2", "resp2", 13373, "C:\Windows\file2.docx")) + Call Dev_ExpectEQ(2, iTasks.Cells(FIRST_ROW, S_TASK_ID)) + + Exit Function +PROPAGATE_ERROR: + Call Dev_LogError(Err.Number, Err.Description) +End Function diff --git a/src/s_FileScaner.cls b/src/s_FileScaner.cls new file mode 100644 index 0000000..3907e5c --- /dev/null +++ b/src/s_FileScaner.cls @@ -0,0 +1,78 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "s_FileScaner" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private iScaner_ As FileScaner +Private word_ As API_WordWrapper +Private doc_ As Word.Document + +Public Function Setup() + ' Mandatory setup function + Set word_ = New API_WordWrapper: Call word_.CreateApplication + Set doc_ = word_.NewDocument + Set iScaner_ = New FileScaner +End Function + +Public Function Teardown() + ' Mandatory teardown function + Call word_.ReleaseDocument + Call ClearAll +End Function + +Public Function t_EmptyFile() + On Error GoTo PROPAGATE_ERROR + + Call Dev_ExpectEQ(0, iScaner_.ProcessDocument(doc_), "Do not scan tasks") + Call Dev_ExpectEQ(1, Sources().Count, "Add source") + + Exit Function +PROPAGATE_ERROR: + Call Dev_LogError(Err.Number, Err.Description) +End Function + +Public Function t_ScanContents() + On Error GoTo PROPAGATE_ERROR + + Dim iTasks As Excel.Worksheet: Set iTasks = ThisWorkbook.Sheets(SHEET_TASKS) + + Dim iTable As Word.Table: Set iTable = doc_.Tables.Add(doc_.Range, 3, 3) + iTable.Cell(1, 3).Range.Text = "Project" + iTable.Cell(3, 2).Range.Text = "2005-01-12" + Dim dDate As Double: dDate = VBA.DateValue("2005-01-12") + + Call doc_.Range.InsertAfter(":" & vbNewLine) + Call doc_.Range.InsertAfter("Task 1@@" & vbNewLine) + Call doc_.Range.InsertAfter("Task 2 @@Person") + + Call Dev_ExpectEQ(2, iScaner_.ProcessDocument(doc_), "Task count") + Call Dev_ExpectEQ(1, Sources().Count, "Add source") + + Call Dev_NewCase("Task without responsible") + Call Dev_ExpectEQ(2, iTasks.Cells(FIRST_ROW, S_TASK_ID)) + Call Dev_ExpectEQ(dDate, iTasks.Cells(FIRST_ROW, S_TASK_DATE)) + Call Dev_ExpectEQ(T_TT_OPEN, iTasks.Cells(FIRST_ROW, S_TASK_STATUS)) + Call Dev_ExpectEQ("Project", iTasks.Cells(FIRST_ROW, S_TASK_PROJECT)) + Call Dev_ExpectEQ("Task 1", iTasks.Cells(FIRST_ROW, S_TASK_TEXT)) + Call Dev_ExpectEQ("", iTasks.Cells(FIRST_ROW, S_TASK_RESPONSIBLE)) + Call Dev_ExpectEQ(1, iTasks.Cells(FIRST_ROW, S_TASK_SOURCE_ID)) + + Call Dev_NewCase("Task with responsible") + Call Dev_ExpectEQ(1, iTasks.Cells(FIRST_ROW + 1, S_TASK_ID)) + Call Dev_ExpectEQ(dDate, iTasks.Cells(FIRST_ROW + 1, S_TASK_DATE)) + Call Dev_ExpectEQ(T_TT_OPEN, iTasks.Cells(FIRST_ROW + 1, S_TASK_STATUS)) + Call Dev_ExpectEQ("Project", iTasks.Cells(FIRST_ROW + 1, S_TASK_PROJECT)) + Call Dev_ExpectEQ("Task 2", iTasks.Cells(FIRST_ROW + 1, S_TASK_TEXT)) + Call Dev_ExpectEQ("Person", iTasks.Cells(FIRST_ROW + 1, S_TASK_RESPONSIBLE)) + Call Dev_ExpectEQ(1, iTasks.Cells(FIRST_ROW + 1, S_TASK_SOURCE_ID)) + + Exit Function +PROPAGATE_ERROR: + Call Dev_LogError(Err.Number, Err.Description) +End Function