K
Koen
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
(e-mail address removed) (remove NOSPAM)
------------------------ Code -------------------------------------
Option Compare Database
Option Explicit
Public rstFile As ADODB.Recordset
Public rstDB As ADODB.Recordset
Private Sub Command0_Click()
Build_File_RecordSet
Build_DB_RecordSet
Synchronize_DB
End Sub
Sub Build_File_RecordSet()
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, adLockBatchOptimistic
'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:\Bookz\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.MoveNext
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_RecordSet()
Dim conZEP As ADODB.Connection
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.Connection
Set rstDB = New ADODB.Recordset
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= " & Database
' conZEP.ConnectionString = ConnString
conZEP.Open ConnString
rstDB.Open SQLString$, conZEP, adOpenKeyset, adLockOptimistic
End Sub
Sub Synchronize_DB()
' Initialise
Dim varDBBookmark As Variant
Dim varTmpDBBookmark As Variant
Dim varFileBookmark As Variant
Dim intAddCounter As Integer
Dim intDeleteCounter As Integer
Dim intCheckCounter As Integer
Dim intReplaceCounter As Integer
Dim strTargetFile As String
Dim Succes As Boolean
Dim TmpSucces As Boolean
intAddCounter = 0
intDeleteCounter = 0
intCheckCounter = 0
intReplaceCounter = 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("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
rstDB.Fields("Stempel") = rstFile.Fields("Stamp").Value
rstDB.Fields("Lengte") = rstFile.Fields("Length").Value
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNext
rstDB.MoveNext
Else
If UCase(rstFile.Fields("FileName").Value) = UCase(rstDB.Fields("Bestand").Value) Then
' File recordset row and DB recordset row are equal
' Do nothing, go to next row in both sets.
rstFile.MoveNext
rstDB.MoveNext
intCheckCounter = intCheckCounter + 1
ElseIf UCase(rstFile.Fields("FileName").Value) < UCase(rstDB.Fields("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("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
rstDB.Fields("Stempel") = rstFile.Fields("Stamp").Value
rstDB.Fields("Lengte") = rstFile.Fields("Length").Value
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNext
rstDB.Bookmark = varDBBookmark
ElseIf UCase(rstFile.Fields("FileName").Value) > UCase(rstDB.Fields("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.Fields("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.Bookmark
rstFile.Sort = "Stamp ASC"
rstFile.MoveFirst
Succes = False
Do While (Succes = False) And (rstFile.EOF = False)
If (UCase(rstFile.Fields("Stamp").Value) = UCase(rstDB.Fields("Stempel").Value)) And _
(UCase(rstFile.Fields("Length").Value) = UCase(rstDB.Fields("Lengte").Value)) 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.Fields("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.
varTmpDBBookmark = 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("FileName").Value) = UCase(rstDB.Fields("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 = varTmpDBBookmark
rstDB.Fields("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
intReplaceCounter = intReplaceCounter + 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
intDeleteCounter = intDeleteCounter + 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.MoveNext
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
intDeleteCounter = intDeleteCounter + 1
End If
rstDB.MoveNext
' Restore sorting order of File Recordset and restore position
rstFile.Sort = "FileName ASC"
rstFile.Bookmark = varFileBookmark
End If
End If
Loop
' Show result of synchronisation run
MsgBox intAddCounter & " records added. " & vbCrLf & _
intCheckCounter & " records matched. " & vbCrLf & _
intReplaceCounter & " records replaced." & vbCrLf & _
intDeleteCounter & " 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
(e-mail address removed) (remove NOSPAM)
------------------------ Code -------------------------------------
Option Compare Database
Option Explicit
Public rstFile As ADODB.Recordset
Public rstDB As ADODB.Recordset
Private Sub Command0_Click()
Build_File_RecordSet
Build_DB_RecordSet
Synchronize_DB
End Sub
Sub Build_File_RecordSet()
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, adLockBatchOptimistic
'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:\Bookz\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.MoveNext
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_RecordSet()
Dim conZEP As ADODB.Connection
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.Connection
Set rstDB = New ADODB.Recordset
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= " & Database
' conZEP.ConnectionString = ConnString
conZEP.Open ConnString
rstDB.Open SQLString$, conZEP, adOpenKeyset, adLockOptimistic
End Sub
Sub Synchronize_DB()
' Initialise
Dim varDBBookmark As Variant
Dim varTmpDBBookmark As Variant
Dim varFileBookmark As Variant
Dim intAddCounter As Integer
Dim intDeleteCounter As Integer
Dim intCheckCounter As Integer
Dim intReplaceCounter As Integer
Dim strTargetFile As String
Dim Succes As Boolean
Dim TmpSucces As Boolean
intAddCounter = 0
intDeleteCounter = 0
intCheckCounter = 0
intReplaceCounter = 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("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
rstDB.Fields("Stempel") = rstFile.Fields("Stamp").Value
rstDB.Fields("Lengte") = rstFile.Fields("Length").Value
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNext
rstDB.MoveNext
Else
If UCase(rstFile.Fields("FileName").Value) = UCase(rstDB.Fields("Bestand").Value) Then
' File recordset row and DB recordset row are equal
' Do nothing, go to next row in both sets.
rstFile.MoveNext
rstDB.MoveNext
intCheckCounter = intCheckCounter + 1
ElseIf UCase(rstFile.Fields("FileName").Value) < UCase(rstDB.Fields("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("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
rstDB.Fields("Stempel") = rstFile.Fields("Stamp").Value
rstDB.Fields("Lengte") = rstFile.Fields("Length").Value
rstDB.Update
intAddCounter = intAddCounter + 1
rstFile.MoveNext
rstDB.Bookmark = varDBBookmark
ElseIf UCase(rstFile.Fields("FileName").Value) > UCase(rstDB.Fields("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.Fields("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.Bookmark
rstFile.Sort = "Stamp ASC"
rstFile.MoveFirst
Succes = False
Do While (Succes = False) And (rstFile.EOF = False)
If (UCase(rstFile.Fields("Stamp").Value) = UCase(rstDB.Fields("Stempel").Value)) And _
(UCase(rstFile.Fields("Length").Value) = UCase(rstDB.Fields("Lengte").Value)) 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.Fields("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.
varTmpDBBookmark = 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("FileName").Value) = UCase(rstDB.Fields("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 = varTmpDBBookmark
rstDB.Fields("Bestand") = rstFile.Fields("FileName").Value
rstDB.Fields("Extentie") = rstFile.Fields("Extension").Value
intReplaceCounter = intReplaceCounter + 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
intDeleteCounter = intDeleteCounter + 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.MoveNext
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
intDeleteCounter = intDeleteCounter + 1
End If
rstDB.MoveNext
' Restore sorting order of File Recordset and restore position
rstFile.Sort = "FileName ASC"
rstFile.Bookmark = varFileBookmark
End If
End If
Loop
' Show result of synchronisation run
MsgBox intAddCounter & " records added. " & vbCrLf & _
intCheckCounter & " records matched. " & vbCrLf & _
intReplaceCounter & " records replaced." & vbCrLf & _
intDeleteCounter & " records deleted."
End Sub