Sayın Hayri16

do until rs.eof 'Tablo sonuna kadar

if scurdir & scurfile <> rs!dosya_adi then 'şart

end if 

rs.MoveNext 'sonraki kayıt

loop

gibi denemelerim oldu fakat bundada ne hikmetse gelen ilk veride kontrol ediyor tamam viri kayıtlı diyo diğerleri kayıtlı olsada eklemeye devam ediyor. Accesste bu problemi sizin verdiğiniz yukardaki DCount fonksiyonu ile çözmüştük. Dedim vb6 ya geçeyim birazdaha görsellik eklim yarısını bitirdim derken yine burada takıldım kaldım
Kodun tamamı

Function ListDir(ByVal StartDir As String) As Collection

Dim rs As New ADODB.Recordset

rs.Open "TblDosyalar", CurrentProject.Connection, adOpenKeyset, adLockOptimistic



Dim sCurFile As String

Dim sCurDir As String

Dim colDir As Collection



If Right$(StartDir, 1) <> "\" Then StartDir = StartDir & "\"

Set colDir = New Collection

Set ListDir = New Collection



colDir.Add StartDir

While colDir.Count

    'remove current directory from directory list

    sCurDir = colDir.Item(1)

    colDir.Remove 1

    'find all files and subdirectories in current, add to list

    sCurFile = Dir$(sCurDir, vbDirectory)

    

    While Len(sCurFile)

        If (sCurFile <> ".") And (sCurFile <> "..") Then 'get rid of "." and ".."

            If GetAttr(sCurDir & sCurFile) = vbDirectory Then  'add the sub directory

                colDir.Add sCurDir & sCurFile & "\"

            Else 'work on the file

                If DCount("Dosya_yolu", TblDosyalar, "Dosya_yolu='" & sCurDir & sCurFile & "'") > 0 Then

                Else

                ListDir.Add sCurDir & sCurFile

                rs.AddNew

                rs!dosya_yolu = sCurDir & sCurFile

                rs!dosya_ismi = sCurFile

                rs.Update

            End If

        End If

        sCurFile = Dir$

    Wend

    DoEvents

Wend

End Function

şeklinde yardım edebilirseniz çok sevnirim.