Concept-Mining/src/database/DataAccess.bas
2024-06-07 20:09:31 +03:00

67 lines
2.0 KiB
QBasic

Attribute VB_Name = "DataAccess"
Option Explicit
Option Private Module
' TODO: incapsulate into DB class
Private Const SHEET_SOURCE = "Èñòî÷íèêè"
Private Const SHEET_DATA = "Äàííûå"
Public Function DataSheet() As Excel.Worksheet
Set DataSheet = ThisWorkbook.Sheets(SHEET_DATA)
End Function
Public Function SourceSheet() As Excel.Worksheet
Set SourceSheet = ThisWorkbook.Sheets(SHEET_SOURCE)
End Function
Public Function AddSource(target As Word.Document) As Long
AddSource = SourceSheet.Cells(GetRowFor(target.FullName), SS_ID)
End Function
Public Function SourceFileFor(sourceID&) As String
Dim foundRng As Excel.Range
Set foundRng = SourceSheet.Columns(SS_ID).Find(sourceID, LookAt:=xlWhole)
If foundRng Is Nothing Then _
Exit Function
SourceFileFor = SourceSheet.Cells(foundRng.Row, SS_PATH)
End Function
Public Function RowFor(sourceID&) As Long
Dim foundRng As Excel.Range
Set foundRng = SourceSheet.Columns(SS_ID).Find(sourceID, LookAt:=xlWhole)
If foundRng Is Nothing Then _
Exit Function
RowFor = foundRng.Row
End Function
' ====
Private Function GetNextID() As Long
Dim docsSht As Excel.Worksheet: Set docsSht = SourceSheet
Dim nRow&: nRow = DEFAULT_FIRST_ROW
Dim theID&: theID = 1
Do While docsSht.Cells(nRow, SS_ID) <> vbNullString
If theID >= docsSht.Cells(nRow, SS_ID) Then _
theID = docsSht.Cells(nRow, SS_ID) + 1
nRow = nRow + 1
Loop
GetNextID = theID
End Function
Private Function GetRowFor(target$) As Long
Dim theSheet As Excel.Worksheet: Set theSheet = SourceSheet
Dim foundRng As Excel.Range
Set foundRng = theSheet.Columns(SS_PATH).Find(target, LookAt:=xlWhole)
If foundRng Is Nothing Then
Dim nRow&: nRow = theSheet.Columns(SS_ID).Find(vbNullString, LookAt:=xlWhole).Row
theSheet.Cells(nRow, SS_ID) = GetNextID
theSheet.Cells(nRow, SS_PATH) = target
Call theSheet.Cells(nRow, SS_PATH).Hyperlinks.Add(theSheet.Cells(nRow, SS_PATH), target)
GetRowFor = nRow
Else
GetRowFor = foundRng.Row
End If
End Function