Attribute VB_Name = "DataAccess" Option Private Module Option Explicit Public Function AccessDatabase() As InfoDatabase Static s_AccessDatabase As InfoDatabase On Error GoTo CREATE_NEW Set AccessDatabase = s_AccessDatabase.Validate Exit Function CREATE_NEW: Set s_AccessDatabase = New InfoDatabase Call s_AccessDatabase.Init(ThisWorkbook, GetDocumentsLocation(ThisWorkbook)) Set AccessDatabase = s_AccessDatabase End Function Public Function SetDocumentsLocation(sDir$) ThisWorkbook.Names(HT03_CELL_FOLDER).RefersToRange = sDir AccessDatabase.docsLocation_ = GetDocumentsLocation(ThisWorkbook) End Function Public Function ClearAll() ThisWorkbook.Names(CELL_STAT_BASE).RefersToRange = 0 Call SetDocumentsLocation(HT03_DEFAULT_WORKDIR) Call ThisWorkbook.Sheets(HT03_SHT_DOCS).UsedRange.Offset(1).ClearContents Call ThisWorkbook.Sheets(HT03_SHT_LINKS).UsedRange.Offset(1).ClearContents End Function Public Function GetIndexDump() As Long() Dim theDB As InfoDatabase: Set theDB = AccessDatabase GetIndexDump = theDB.IndexDump End Function Public Function GetLinksDump(target&) As Long() Dim theDB As InfoDatabase: Set theDB = AccessDatabase GetLinksDump = theDB.LinksDumpFor(target) End Function Public Function SetLinksFor(target&, linksData() As String) Dim theDB As InfoDatabase: Set theDB = AccessDatabase If Not theDB.Contains(target) Then _ Exit Function Call theDB.StartOptimization Call theDB.DeleteLinksFor(target) Call theDB.SetLinksInternal(target, linksData) Call theDB.EndOptimization End Function Public Function RemoveLinksFor(target&) As Long RemoveLinksFor = 0 Dim lnksSht As Excel.Worksheet: Set lnksSht = ThisWorkbook.Sheets(HT03_SHT_LINKS) Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE Do While lnksSht.Cells(nRow, S_L_FROM_ID) <> vbNullString If lnksSht.Cells(nRow, S_L_FROM_ID) = target Then lnksSht.Rows(nRow).Delete RemoveLinksFor = RemoveLinksFor + 1 Else nRow = nRow + 1 End If Loop End Function Public Function RemoveIDFromDocs(target&) As String Dim docsSht As Excel.Worksheet: Set docsSht = ThisWorkbook.Sheets(HT03_SHT_DOCS) Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE Do While docsSht.Cells(nRow, S_D_GARANT_ID) <> vbNullString If docsSht.Cells(nRow, S_D_GARANT_ID) = target Then Dim theFile$: theFile = docsSht.Cells(nRow, S_D_FILENAME) If theFile <> HT03_FILE_NOT_LOADED Then theFile = AccessDatabase.docsLocation_ & "/" & theFile Else theFile = vbNullString End If docsSht.Rows(nRow).Delete RemoveIDFromDocs = theFile Exit Function End If nRow = nRow + 1 Loop End Function Public Function SubstituteLinks(nDelete&, nSubstitute&) Dim lnksSht As Excel.Worksheet: Set lnksSht = ThisWorkbook.Sheets(HT03_SHT_LINKS) Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE Do Dim sID$: sID = lnksSht.Cells(nRow, S_L_TO_ID) If sID = vbNullString Then _ Exit Do If sID = nDelete Then _ lnksSht.Cells(nRow, S_L_TO_ID) = nSubstitute nRow = nRow + 1 Loop End Function