Code:
Public Function SearchFile()
'*******************************************
'Ime:      SearchFile  (Function)
'Sadržaj:   Trazenje fajlova na disku
'Autor:     ZXZ
'Datum:      rujan 05, 2008, 03:26:54
'Adresa: Tuzla BiH
'Email:     [email protected]
'Ulazni parametri:
'Izlazni parametri:
'*******************************************
Dim Db As Database
Dim Rs As Recordset
Dim Rsp As Recordset
Dim I As Integer
Dim R, Rp As Integer


'On Error GoTo Kraj
Call TabelaZapisa
With Application.FileSearch 'odredi opcije trazenja
.NewSearch ' nova pretraga
.LookIn = "C:\Tmp\nn" ' putanja
'.SearchSubFolders = True ' trazi i u pod direktorijima

.MatchAllWordForms = True 'ova 2 red nisam siguran kako protumaciti
.FileType = 1 ' tip fajla misli se na exstenziju 1--Sve extenzije 2-- xls file
    If .Execute() > 0 Then ' ako je sta nadjeno tada
    MsgBox " Ima: " & .Execute & " Datoteka"
    Beep
R = MsgBox("Da pobrišem poslije zapisa?", vbYesNo + vbDefaultButton2, "Pitanje")
    Set Db = CurrentDb
        Set Rs = Db.OpenRecordset("SELECT * FROM Putanje")
        For I = 1 To .FoundFiles.Count
        Set Rsp = Db.OpenRecordset("SELECT Putanja   FROM Putanje WHERE Putanja='" & .FoundFiles(I) & "'")
            If Rsp.RecordCount > 0 Then
            Rp = MsgBox("Datoteka: <" & .FoundFiles(I) & "> postoji u tabeli." & vbCr & _
            "Zapisi ponovo <Yes>" & vbCr _
            & "Nemoj zapisati  <No> " & vbCr & _
            "Prekini cio posupak <Cancel>", vbYesNoCancel + vbDefaultButton3, "Napomena")
            End If
            Rsp.Close
           If Rp = 0 Or Rp = 6 Then
                        Rs.AddNew
                        Rs.Fields(1) = .FoundFiles(I)
                        Rs.Fields(2) = Now
                        Rs.Update
                        MsgBox .FoundFiles(I)
                            If R = vbYes Then
                            Kill .FoundFiles(I)
                            End If
             ElseIf Rp = 2 Then
                        Rsp.Close
                        Set Db = Nothing
                        GoTo Izlaz
             End If
        Next I
        Rs.Close
        Set Db = Nothing
        Else 'ince
    MsgBox "nije nađeno!" ' upozorenjeda nije nadjeno
    End If ' kraj uslova
End With ' kraj opcija
Izlaz:
Exit Function
Kraj:
MsgBox "Greška Br: " & Err.Number & vbCr & Err.Description
GoTo Izlaz
End Function

Code:
Function TabelaZapisa()
'*******************************************
'Ime:      TabelaZapisa  (Function)
'Sadržaj:   Trazenje fajlova na disku
'Autor:     ZXZ
'Datum:      rujan 04, 2007, 12:3:33
'Adresa: Tuzla BiH
'Email:     [email protected]
'Ulazni parametri:
'Izlazni parametri:
'*******************************************
Dim Db As Database
Dim Tbl As TableDef
Dim Qd As QueryDef
Dim ImeTabele As String
Dim T As Boolean
Dim SQL As String

Set Db = CurrentDb
For Each Tbl In Db.TableDefs
ImeTabele = Tbl.Name
If ImeTabele = "Putanje" Then: T = True
Next Tbl

If T = False Then ' Ako nema tbale kriraj
SQL = "CREATE TABLE Putanje (ID Counter, Putanja TEXT(255) ,Datum Date)"
DoCmd.RunSQL SQL
End If

T = False
For Each Qd In Db.QueryDefs
If Qd.Name = "QPutanje" Then: T = True
Next Qd
If T = False Then
SQL = "SELECT ImeFilea([Putanja]) AS Ime, * FROM Putanje"
Set Qd = Db.CreateQueryDef("QPutanja", SQL)
End If
Set Db = Nothing
End Function
Function ImeFilea(Ime As String) As String
'*******************************************
'Ime:      TabelaZapisa  (Function)
'Sadržaj:   Trazenje fajlova na disku
'Autor:     ZXZ
'Datum:      rujan 07, 2008, 11:13:22
'Adresa: Tuzla BiH
'Email:     [email protected]
'Ulazni parametri:
'Izlazni parametri:
'*******************************************
Dim Fajl As String
    
    On Error Resume Next
Fajl = Ime
    Do Until Right$(Ime, 1) = "\"
        Ime = Left$(Ime, Len(Ime) - 1)
    Loop
ImeFilea = Right(Fajl, Len(Fajl) - Len(Ime))
End Function