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
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
bu koda bir türlü tabloda var ise kaydetme diye dedirtemedim. Yardımlarınız için şimdiden tşk ederim.
If DCount("ID", "gidenevrak", [mudno]=" & b & " ") > 0 Then
msgbox"tabloda var"
exit sub
end if
Açıklama
"ID" tabloda saydıracağın
"gidenevrak" tablo adı
"mudno" tabloda bakılacak alan
"b" de formdaki denetim mesala adı metin kutusu yani tabloda olana baktıracağın
kolay gelsin.
Sayın erdem55;
Aşağıdaki kodu
If DCount("Dosya_yolu", "tbldosyalar", "Dosya_yolu='" & sCurDir & sCurFile & "'") > 0 Then
MsgBox ("Bu dosya daha önce Tabloya alınmış")
Else
End If
Bu kodun altına
If GetAttr(sCurDir & sCurFile) = vbDirectory Then 'add the sub directory
colDir.Add sCurDir & sCurFile & "\"
Else 'work on the file
ekleyiniz. Ve lütfen geri bildirimde bulununuz.
Kolay gelsin.
(27/12/2010, 18:36)mzebek yazdı: If DCount("ID", "gidenevrak", [mudno]=" & b & " ") > 0 Then
msgbox"tabloda var"
exit sub
end if
Açıklama
"ID" tabloda saydıracağın
"gidenevrak" tablo adı
"mudno" tabloda bakılacak alan
"b" de formdaki denetim mesala adı metin kutusu yani tabloda olana baktıracağın
kolay gelsin.
Dostum cevabın için tşk edeirm. Fakat sorundada burada tabloda saydırma işlemini koda entegre edemiyorum. ya hataya düşüyo yada birine var deyip diğerlerini ekliyo
benim koddaki bölüm
do until rs.eof 'Tablo sonuna kadar
if scurdir & scurfile <> rs!dosya_adi then 'şart
end if
rs.MoveNext 'sonraki kayıt
loop
şeklinde deniyorum ama dediğim gibi ilk gelen bilgi tabloda var diyo diğerleri tabloda olsa bile yine tabloya ekliyo.
(27/12/2010, 18:49)Hayri16 yazdı: Sayın erdem55;
Aşağıdaki kodu
If DCount("Dosya_yolu", "tbldosyalar", "Dosya_yolu='" & sCurDir & sCurFile & "'") > 0 Then
MsgBox ("Bu dosya daha önce Tabloya alınmış")
Else
End If
Bu kodun altına
If GetAttr(sCurDir & sCurFile) = vbDirectory Then 'add the sub directory
colDir.Add sCurDir & sCurFile & "\"
Else 'work on the file
ekleyiniz. Ve lütfen geri bildirimde bulununuz.
Kolay gelsin.
Sayın Hayri16
Çok tşk ederim. Gayet güzel çalışıyor. Fakat rica etsem
If DCount("Dosya_yolu", "tbldosyalar", "Dosya_yolu='" & sCurDir & sCurFile & "'") > 0 Then
bu kodu açıklayabilirmisiniz acaba? Kodu tam çözemedimde çözmek için. Tekrar tşk ederim.
Syn mzebek
sizede çok tşk ederim doğru bir yönlendirme yaptığınız halde görememişim. Ben rs.eof a takılıp gitmişim. Sizede tekrardan tşk ederim.
Dcount fonksiyonu istenilen şarta uygun verilen tablonun verilen alanındaki bilgiden kaç tane olduğunu sayar. Sayısal bir değer döndürür. Eğer 0 sa 0 kayıttan yoktur. Sıfırdan büyükse vardır demek
Saygılar.