Initial commit

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

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

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

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

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

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

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

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

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

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