By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,482 Members | 2,411 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,482 IT Pros & Developers. It's quick & easy.

Who could solve this bug (in my balanced line)

P: n/a
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
kb******@NOSPAMxs4all.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_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
Nov 12 '05 #1
Share this Question
Share on Google+
1 Reply


P: n/a
After a file is loaded, why not rename it the autnumber or some other
counter such as dmax("[Number]") + 1. Your file would go from doc.txt to
1.txt. Of course, there is no absoulte way to prevent dups in this manner
because doc.txt could be downloaded again and renamed as 2.txt.
--
Dean Covey
www.coveyaccounting.com

MS-Office Certified:
http://www.microsoft.com/learning/mc...st/default.asp

"Koen" <kb******@NOSPAMxs4all.nl> wrote in message
news:Xn*********************@194.109.133.20...
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
kb******@NOSPAMxs4all.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_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

Nov 12 '05 #2

This discussion thread is closed

Replies have been disabled for this discussion.