Hi all,
I created a little database to manage my e-books.
The program will synchronize a table with the contents of a directory.
Works great.
Because I keep additional info (like keywords) to the created
records in the database and I don't want to lose all that info
when I rename a file and synchronise, I've added some code to
the program. It works like this: when the filename of a DB records
cannot be found anymore, it starts looking for a file with identical
filesize and timestamp. When it finds such a file the DB records can
be updated. Now all info related to the DB record remains in tact.
Everything works great, except in one particular situation:
' Known bug:
' When a one of the files is renamed after synchronizing from, for example, "A Doc.txt" to "Doc.txt"
' an error occurs when you start synchronizing again.
'
' The algorithm finds DB record "A Doc.txt", but doesn't find it in de directory.
' It starts looking for a file with identical timestamp en filesize, finds it ("Doc.txt") and asks
' the user to link the file to the DB record. User agrees. The key of the DB records is changed
' from "A Doc.txt" to "Doc.txt".
' The algorithm continues its work browsing thru the File recordset and then finds the
' file "Doc.txt". Instead of having also a row "Doc.txt" in the 'balanced line', it has
' the next in line (for example "Doc2.txt") to compare with.
' Now the program (wrongly) thinks it has found a file without a DB record, so it
' is going to add a DB record. Ofcourse this cannot be done, because the DB record already
' exists.
'
' HELP!!!
I have two questions:
1. Who could solve the described bug.
2. I am a newbie in coding, maybe I am doing strange, unefficient, stupid things in my code. Please tell me, I want to learn!
Kind regards,
--
Koen
kbunders@NOSPAM xs4all.nl (remove NOSPAM)
------------------------ Code -------------------------------------
Option Compare Database
Option Explicit
Public rstFile As ADODB.Recordset
Public rstDB As ADODB.Recordset
Private Sub Command0_Click( )
Build_File_Reco rdSet
Build_DB_Record Set
Synchronize_DB
End Sub
Sub Build_File_Reco rdSet()
On Error GoTo Err_Build_File_ RecordSet
Dim strPath As String
strPath = "Z:\Bookz\"
Set rstFile = New ADODB.Recordset
With rstFile
'Do local work
.CursorLocation = adUseClient
'Add a field here
.Fields.Append "FileName", adVarChar, _
255, adFldRowID
.Fields.Append "Extension" , adChar, _
3, adFldFixed
.Fields.Append "Stamp", adVarChar, _
255
.Fields.Append "Length", adVarChar, _
255
'Open the rstFile
.Open , , adOpenStatic, adLockBatchOpti mistic
'Make sure there is an \ in the path
If Right(strPath, 1) <> "\" Then _
strPath = strPath & "\"
'Get a list of all files in the DIR and then
'add them to the recordset
strPath = Dir(strPath & "*.*", vbNormal)
' Dir returns the first file name that matches pathname.
' To get any additional file names that match pathname, call Dir again
' with no arguments. When no more file names match, Dir returns
' a zero-length string ("").
' Don't include the . and .. entries
Do While strPath > ""
'Add the record to the rstFile here
.AddNew Array("FileName ", "Extension" , "Stamp", "Length"), _
Array(strPath, Right(strPath, 3), FileDateTime("Z :\Bookz\001 ICT\" & strPath), FileLen("Z:\Boo kz\001 ICT\" & strPath))
strPath = Dir
Loop
.MoveFirst
'Print out the files
'You can also return a recordset as a function
'return value to work with the recordset in another
'procedure
Do Until .EOF
Debug.Print !FileName
rstFile.MoveNex t
Loop
End With
rstFile.Sort = "FileName ASC"
Exit_Build_File _RecordSet:
Exit Sub
Err_Build_File_ RecordSet:
MsgBox Err.Description
Resume Exit_Build_File _RecordSet
End Sub
Sub Build_DB_Record Set()
Dim conZEP As ADODB.Connectio n
Dim Database As String
Dim ConnString As String
Dim SQLString As String
Database = "E:\Bookz database\Bookz database.mdb"
SQLString = "SELECT * FROM Bestandsnaam ORDER BY Bestand;"
Set conZEP = New ADODB.Connectio n
Set rstDB = New ADODB.Recordset
ConnString = "Provider=Micro soft.Jet.OLEDB. 4.0;" & _
"Data Source= " & Database
' conZEP.Connecti onString = ConnString
conZEP.Open ConnString
rstDB.Open SQLString$, conZEP, adOpenKeyset, adLockOptimisti c
End Sub
Sub Synchronize_DB( )
' Initialise
Dim varDBBookmark As Variant
Dim varTmpDBBookmar k As Variant
Dim varFileBookmark As Variant
Dim intAddCounter As Integer
Dim intDeleteCounte r As Integer
Dim intCheckCounter As Integer
Dim intReplaceCount er As Integer
Dim strTargetFile As String
Dim Succes As Boolean
Dim TmpSucces As Boolean
intAddCounter = 0
intDeleteCounte r = 0
intCheckCounter = 0
intReplaceCount er = 0
' Balanced line approach
' Walk thru complete File recordset and compare to DB recordset row by row
Do While rstFile.EOF = False
' BOF - Indicates that the current record position is before the first record in a Recordset object.
' (if the current record position is not on or after the first record).
'
' EOF - Indicates that the current record position is after the last record in a Recordset object.
' (if the current record position is not on or before the last record).
'
' If either the BOF or EOF property is True, there is no current record.
If rstDB.EOF = True Or rstDB.BOF = True Then
rstDB.AddNew
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
rstDB.Fields("S tempel") = rstFile.Fields( "Stamp").Va lue
rstDB.Fields("L engte") = rstFile.Fields( "Length").V alue
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNex t
rstDB.MoveNext
Else
If UCase(rstFile.F ields("FileName ").Value) = UCase(rstDB.Fie lds("Bestand"). Value) Then
' File recordset row and DB recordset row are equal
' Do nothing, go to next row in both sets.
rstFile.MoveNex t
rstDB.MoveNext
intCheckCounter = intCheckCounter + 1
ElseIf UCase(rstFile.F ields("FileName ").Value) < UCase(rstDB.Fie lds("Bestand"). Value) Then
' A row is found in File recordset that does not exist in DB Recordset
' Add row to DB Recordset
' Known bug:
' When a one of the files is renamed after synchronizing from, for example, "A Doc.txt" to "Doc.txt"
' an error occurs when you start synchronizing again.
'
' The algorithm finds DB record "A Doc.txt", but doesn't find it in de directory.
' It starts looking for a file with identical timestamp en filesize, finds it ("Doc.txt") and asks
' the user to link the file to the DB record. User agrees. The key of the DB records is changed
' from "A Doc.txt" to "Doc.txt".
' The algorithm continues its work browsing thru the File recordset and then finds the
' file "Doc.txt". Instead of having also a row "Doc.txt" in the 'balanced line', it has
' the next in line (for example "Doc2.txt") to compare with.
' Now the program (wrongly) thinks it has found a file without a DB record, so it
' is going to add a DB record. Ofcourse this cannot be done, because the DB record already
' exists.
'
' HELP!!!
' (The bug is caused in the next ElseIf part, because after renaming the DB record,
' the DB recordset remains unsorted)
varDBBookmark = rstDB.Bookmark
rstDB.AddNew
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
rstDB.Fields("S tempel") = rstFile.Fields( "Stamp").Va lue
rstDB.Fields("L engte") = rstFile.Fields( "Length").V alue
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNex t
rstDB.Bookmark = varDBBookmark
ElseIf UCase(rstFile.F ields("FileName ").Value) > UCase(rstDB.Fie lds("Bestand"). Value) Then
' A row is found in DB recordset that does not exist in File Recordset
' Before deleting the row in the DB recordset,
' browse thru complete File recordset again and check if any file has same
' filesize and timestamp as the original file in DB recordset.
' If a file is found, it could be that the file was renamed after the last synchronisation .
'
' The user is asked to link the file with same filesize and timestamp to the
' original DB record. If yes, the original filename is updated with the new filename in the DB recordset.
' But first it is checked if the new filename wasn't already added during the current
' synchorisation round.
' If the user does not want to relink or no matching file is found, the DB record is deleted.
' It is probable that the file was deleted after the last synchronisation .
'
' Attention: relinking causes a bug as mentioned in the ElseIf part above.
strTargetFile = UCase(rstDB.Fie lds("Bestand"). Value)
' Remember where we were in File recordset
' Sort File recordset on timestamp
' Use the MoveFirst method to move the current record position to the first record in the Recordset.
varFileBookmark = rstFile.Bookmar k
rstFile.Sort = "Stamp ASC"
rstFile.MoveFir st
Succes = False
Do While (Succes = False) And (rstFile.EOF = False)
If (UCase(rstFile. Fields("Stamp") .Value) = UCase(rstDB.Fie lds("Stempel"). Value)) And _
(UCase(rstFile. Fields("Length" ).Value) = UCase(rstDB.Fie lds("Lengte").V alue)) Then
' A file with same filesize and timestamp as the original file in DB recordset is found in de File recordset.
Succes = True
' The user is asked to link the file with same filesize and timestamp to the
' original DB record.
If vbYes = MsgBox("The file with filename " & strTargetFile & " could not be found. " & vbCrLf & vbCrLf & _
"Maybe it was renamed to " & UCase(rstFile.F ields("FileName ").Value) & ". " & vbCrLf & _
"Both files have same time and date stamps. " & vbCrLf & vbCrLf & _
"Would you like to relink?", vbQuestion + vbYesNo, "No exact filename found") Then
' If yes, the original filename is updated with the new filename in the DB recordset.
' But first it is checked if the new filename wasn't already added during the current
' synchorisation round.
' Remember position in DB recordset and move to first record.
varTmpDBBookmar k = rstDB.Bookmark
rstDB.MoveFirst
' Start looking for a record in DB recordset with new filename.
TmpSucces = False
Do While (TmpSucces = False) And (rstDB.EOF = False)
If (UCase(rstFile. Fields("FileNam e").Value) = UCase(rstDB.Fie lds("Bestand"). Value)) Then
' A record in DB recordset with new filename is found and will be deleted.
TmpSucces = True
rstDB.Delete
rstDB.Update
intAddCounter = intAddCounter - 1
Else
' No record found (yet)
End If
rstDB.MoveNext
Loop
' Question: Will sorting the DB recordset solve the bug as described above?
' Restore position in DB recordset
rstDB.Bookmark = varTmpDBBookmar k
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
intReplaceCount er = intReplaceCount er + 1
rstDB.Update
Else
' The user chooses _not_ to link the file with same filesize and timestamp to the
' original DB record. The original DB record is deleted.
MsgBox "Record deleted."
rstDB.Delete
rstDB.Update
intDeleteCounte r = intDeleteCounte r + 1
End If
Else
' A file with same filesize and timestamp as the
' original file in DB recordset is _not_ found in de File recordset (yet).
End If
rstFile.MoveNex t
Loop
If Succes = False Then
' File recordset is completly searched, but a file with same filesize and timestamp as the
' original file in DB recordset is _not_ found in de File recordset.
' The original DB record is deleted.
MsgBox "Record deleted."
rstDB.Delete
rstDB.Update
intDeleteCounte r = intDeleteCounte r + 1
End If
rstDB.MoveNext
' Restore sorting order of File Recordset and restore position
rstFile.Sort = "FileName ASC"
rstFile.Bookmar k = varFileBookmark
End If
End If
Loop
' Show result of synchronisation run
MsgBox intAddCounter & " records added. " & vbCrLf & _
intCheckCounter & " records matched. " & vbCrLf & _
intReplaceCount er & " records replaced." & vbCrLf & _
intDeleteCounte r & " records deleted."
End Sub
I created a little database to manage my e-books.
The program will synchronize a table with the contents of a directory.
Works great.
Because I keep additional info (like keywords) to the created
records in the database and I don't want to lose all that info
when I rename a file and synchronise, I've added some code to
the program. It works like this: when the filename of a DB records
cannot be found anymore, it starts looking for a file with identical
filesize and timestamp. When it finds such a file the DB records can
be updated. Now all info related to the DB record remains in tact.
Everything works great, except in one particular situation:
' Known bug:
' When a one of the files is renamed after synchronizing from, for example, "A Doc.txt" to "Doc.txt"
' an error occurs when you start synchronizing again.
'
' The algorithm finds DB record "A Doc.txt", but doesn't find it in de directory.
' It starts looking for a file with identical timestamp en filesize, finds it ("Doc.txt") and asks
' the user to link the file to the DB record. User agrees. The key of the DB records is changed
' from "A Doc.txt" to "Doc.txt".
' The algorithm continues its work browsing thru the File recordset and then finds the
' file "Doc.txt". Instead of having also a row "Doc.txt" in the 'balanced line', it has
' the next in line (for example "Doc2.txt") to compare with.
' Now the program (wrongly) thinks it has found a file without a DB record, so it
' is going to add a DB record. Ofcourse this cannot be done, because the DB record already
' exists.
'
' HELP!!!
I have two questions:
1. Who could solve the described bug.
2. I am a newbie in coding, maybe I am doing strange, unefficient, stupid things in my code. Please tell me, I want to learn!
Kind regards,
--
Koen
kbunders@NOSPAM xs4all.nl (remove NOSPAM)
------------------------ Code -------------------------------------
Option Compare Database
Option Explicit
Public rstFile As ADODB.Recordset
Public rstDB As ADODB.Recordset
Private Sub Command0_Click( )
Build_File_Reco rdSet
Build_DB_Record Set
Synchronize_DB
End Sub
Sub Build_File_Reco rdSet()
On Error GoTo Err_Build_File_ RecordSet
Dim strPath As String
strPath = "Z:\Bookz\"
Set rstFile = New ADODB.Recordset
With rstFile
'Do local work
.CursorLocation = adUseClient
'Add a field here
.Fields.Append "FileName", adVarChar, _
255, adFldRowID
.Fields.Append "Extension" , adChar, _
3, adFldFixed
.Fields.Append "Stamp", adVarChar, _
255
.Fields.Append "Length", adVarChar, _
255
'Open the rstFile
.Open , , adOpenStatic, adLockBatchOpti mistic
'Make sure there is an \ in the path
If Right(strPath, 1) <> "\" Then _
strPath = strPath & "\"
'Get a list of all files in the DIR and then
'add them to the recordset
strPath = Dir(strPath & "*.*", vbNormal)
' Dir returns the first file name that matches pathname.
' To get any additional file names that match pathname, call Dir again
' with no arguments. When no more file names match, Dir returns
' a zero-length string ("").
' Don't include the . and .. entries
Do While strPath > ""
'Add the record to the rstFile here
.AddNew Array("FileName ", "Extension" , "Stamp", "Length"), _
Array(strPath, Right(strPath, 3), FileDateTime("Z :\Bookz\001 ICT\" & strPath), FileLen("Z:\Boo kz\001 ICT\" & strPath))
strPath = Dir
Loop
.MoveFirst
'Print out the files
'You can also return a recordset as a function
'return value to work with the recordset in another
'procedure
Do Until .EOF
Debug.Print !FileName
rstFile.MoveNex t
Loop
End With
rstFile.Sort = "FileName ASC"
Exit_Build_File _RecordSet:
Exit Sub
Err_Build_File_ RecordSet:
MsgBox Err.Description
Resume Exit_Build_File _RecordSet
End Sub
Sub Build_DB_Record Set()
Dim conZEP As ADODB.Connectio n
Dim Database As String
Dim ConnString As String
Dim SQLString As String
Database = "E:\Bookz database\Bookz database.mdb"
SQLString = "SELECT * FROM Bestandsnaam ORDER BY Bestand;"
Set conZEP = New ADODB.Connectio n
Set rstDB = New ADODB.Recordset
ConnString = "Provider=Micro soft.Jet.OLEDB. 4.0;" & _
"Data Source= " & Database
' conZEP.Connecti onString = ConnString
conZEP.Open ConnString
rstDB.Open SQLString$, conZEP, adOpenKeyset, adLockOptimisti c
End Sub
Sub Synchronize_DB( )
' Initialise
Dim varDBBookmark As Variant
Dim varTmpDBBookmar k As Variant
Dim varFileBookmark As Variant
Dim intAddCounter As Integer
Dim intDeleteCounte r As Integer
Dim intCheckCounter As Integer
Dim intReplaceCount er As Integer
Dim strTargetFile As String
Dim Succes As Boolean
Dim TmpSucces As Boolean
intAddCounter = 0
intDeleteCounte r = 0
intCheckCounter = 0
intReplaceCount er = 0
' Balanced line approach
' Walk thru complete File recordset and compare to DB recordset row by row
Do While rstFile.EOF = False
' BOF - Indicates that the current record position is before the first record in a Recordset object.
' (if the current record position is not on or after the first record).
'
' EOF - Indicates that the current record position is after the last record in a Recordset object.
' (if the current record position is not on or before the last record).
'
' If either the BOF or EOF property is True, there is no current record.
If rstDB.EOF = True Or rstDB.BOF = True Then
rstDB.AddNew
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
rstDB.Fields("S tempel") = rstFile.Fields( "Stamp").Va lue
rstDB.Fields("L engte") = rstFile.Fields( "Length").V alue
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNex t
rstDB.MoveNext
Else
If UCase(rstFile.F ields("FileName ").Value) = UCase(rstDB.Fie lds("Bestand"). Value) Then
' File recordset row and DB recordset row are equal
' Do nothing, go to next row in both sets.
rstFile.MoveNex t
rstDB.MoveNext
intCheckCounter = intCheckCounter + 1
ElseIf UCase(rstFile.F ields("FileName ").Value) < UCase(rstDB.Fie lds("Bestand"). Value) Then
' A row is found in File recordset that does not exist in DB Recordset
' Add row to DB Recordset
' Known bug:
' When a one of the files is renamed after synchronizing from, for example, "A Doc.txt" to "Doc.txt"
' an error occurs when you start synchronizing again.
'
' The algorithm finds DB record "A Doc.txt", but doesn't find it in de directory.
' It starts looking for a file with identical timestamp en filesize, finds it ("Doc.txt") and asks
' the user to link the file to the DB record. User agrees. The key of the DB records is changed
' from "A Doc.txt" to "Doc.txt".
' The algorithm continues its work browsing thru the File recordset and then finds the
' file "Doc.txt". Instead of having also a row "Doc.txt" in the 'balanced line', it has
' the next in line (for example "Doc2.txt") to compare with.
' Now the program (wrongly) thinks it has found a file without a DB record, so it
' is going to add a DB record. Ofcourse this cannot be done, because the DB record already
' exists.
'
' HELP!!!
' (The bug is caused in the next ElseIf part, because after renaming the DB record,
' the DB recordset remains unsorted)
varDBBookmark = rstDB.Bookmark
rstDB.AddNew
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
rstDB.Fields("S tempel") = rstFile.Fields( "Stamp").Va lue
rstDB.Fields("L engte") = rstFile.Fields( "Length").V alue
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNex t
rstDB.Bookmark = varDBBookmark
ElseIf UCase(rstFile.F ields("FileName ").Value) > UCase(rstDB.Fie lds("Bestand"). Value) Then
' A row is found in DB recordset that does not exist in File Recordset
' Before deleting the row in the DB recordset,
' browse thru complete File recordset again and check if any file has same
' filesize and timestamp as the original file in DB recordset.
' If a file is found, it could be that the file was renamed after the last synchronisation .
'
' The user is asked to link the file with same filesize and timestamp to the
' original DB record. If yes, the original filename is updated with the new filename in the DB recordset.
' But first it is checked if the new filename wasn't already added during the current
' synchorisation round.
' If the user does not want to relink or no matching file is found, the DB record is deleted.
' It is probable that the file was deleted after the last synchronisation .
'
' Attention: relinking causes a bug as mentioned in the ElseIf part above.
strTargetFile = UCase(rstDB.Fie lds("Bestand"). Value)
' Remember where we were in File recordset
' Sort File recordset on timestamp
' Use the MoveFirst method to move the current record position to the first record in the Recordset.
varFileBookmark = rstFile.Bookmar k
rstFile.Sort = "Stamp ASC"
rstFile.MoveFir st
Succes = False
Do While (Succes = False) And (rstFile.EOF = False)
If (UCase(rstFile. Fields("Stamp") .Value) = UCase(rstDB.Fie lds("Stempel"). Value)) And _
(UCase(rstFile. Fields("Length" ).Value) = UCase(rstDB.Fie lds("Lengte").V alue)) Then
' A file with same filesize and timestamp as the original file in DB recordset is found in de File recordset.
Succes = True
' The user is asked to link the file with same filesize and timestamp to the
' original DB record.
If vbYes = MsgBox("The file with filename " & strTargetFile & " could not be found. " & vbCrLf & vbCrLf & _
"Maybe it was renamed to " & UCase(rstFile.F ields("FileName ").Value) & ". " & vbCrLf & _
"Both files have same time and date stamps. " & vbCrLf & vbCrLf & _
"Would you like to relink?", vbQuestion + vbYesNo, "No exact filename found") Then
' If yes, the original filename is updated with the new filename in the DB recordset.
' But first it is checked if the new filename wasn't already added during the current
' synchorisation round.
' Remember position in DB recordset and move to first record.
varTmpDBBookmar k = rstDB.Bookmark
rstDB.MoveFirst
' Start looking for a record in DB recordset with new filename.
TmpSucces = False
Do While (TmpSucces = False) And (rstDB.EOF = False)
If (UCase(rstFile. Fields("FileNam e").Value) = UCase(rstDB.Fie lds("Bestand"). Value)) Then
' A record in DB recordset with new filename is found and will be deleted.
TmpSucces = True
rstDB.Delete
rstDB.Update
intAddCounter = intAddCounter - 1
Else
' No record found (yet)
End If
rstDB.MoveNext
Loop
' Question: Will sorting the DB recordset solve the bug as described above?
' Restore position in DB recordset
rstDB.Bookmark = varTmpDBBookmar k
rstDB.Fields("B estand") = rstFile.Fields( "FileName").Val ue
rstDB.Fields("E xtentie") = rstFile.Fields( "Extension").Va lue
intReplaceCount er = intReplaceCount er + 1
rstDB.Update
Else
' The user chooses _not_ to link the file with same filesize and timestamp to the
' original DB record. The original DB record is deleted.
MsgBox "Record deleted."
rstDB.Delete
rstDB.Update
intDeleteCounte r = intDeleteCounte r + 1
End If
Else
' A file with same filesize and timestamp as the
' original file in DB recordset is _not_ found in de File recordset (yet).
End If
rstFile.MoveNex t
Loop
If Succes = False Then
' File recordset is completly searched, but a file with same filesize and timestamp as the
' original file in DB recordset is _not_ found in de File recordset.
' The original DB record is deleted.
MsgBox "Record deleted."
rstDB.Delete
rstDB.Update
intDeleteCounte r = intDeleteCounte r + 1
End If
rstDB.MoveNext
' Restore sorting order of File Recordset and restore position
rstFile.Sort = "FileName ASC"
rstFile.Bookmar k = varFileBookmark
End If
End If
Loop
' Show result of synchronisation run
MsgBox intAddCounter & " records added. " & vbCrLf & _
intCheckCounter & " records matched. " & vbCrLf & _
intReplaceCount er & " records replaced." & vbCrLf & _
intDeleteCounte r & " records deleted."
End Sub
Comment