eklediğim örnekte 2 alanın toplamı kilit alan siz sadece link alanını "Sıralı: Evet-Yineleme Yok " ayarlarsanız da olur
ama şunu sormak istiyorum
(21/03/2019, 10:53)aliyuzen yazdı: 2. Access teki 2_Dosya_Link_T tablosunun içerisine aynı kayıttan atarsa uyarı verdirmem gerekiyor. Mükerrer olmaması adına. Aklıma, tablo ayarından alan özelliğini Sıralı: Evet-Yineleme Yok dersem kayıt atmayacağını biliyorum. ancak, bir mesajı nasıl döndürürüm sizin kodun içinde orayı bilmiyorum.demişsiniz orada benim kaçırdığım 1 nokta var galiba. dosya zaten daha önce taşınmışsa aynı isimdeki dosyayı taşırken ona yeni bir isim veriyor zaten 004 ise 005 yapılarak mükerrer dosya adı çatışması önleniyor.
tek sorun daha önce 004 dosyası eklendiğinden tabloya kaydı yapılmıştır ama daha sonra 004 dosyası silindiği halde tablodan kaydı düşürmediğinde yaşanabilir. o zaman da "Sıralı: Evet-Yineleme Yok " ayarlarsanız zaten eksik dosya yerine konduğundan tabloda mükerrer kayıt önlenmiş olur sorun kalmaz.
benim kaçırdığım nokta tam olarak ne?
Dim MyFile, StrHatalar As String
Dim txtDosyaAdi() As String
Dim HataSay, TasinanSay As Integer
On Error GoTo 10
ReDim DirectoryListArray(10) 'dizi boyutu tanımlıyor
MyFile = Dir$(CurrentProject.Path & "\Müşteriler\_Tarananlar\*.pdf")
'dir() komutu belli bir konumdaki dosyalar arasından ilk dosya adını alır. tekrar çağrılırsa her defasında bir sonraki _
dosya ismi alınır
Counter = 0
Do While MyFile <> "" 'dosya adı boş değer olmadıkça döngü çağrılır
DirectoryListArray(Counter) = Replace(MyFile, ".pdf", "") 'dosya ismi diziye aktarılıyor.
MyFile = Dir$ 'replace() ile pdf uzantısı kaldırılıyor
Counter = Counter + 1
Loop
HataSay = 0
TasinanSay = 0
For x = 0 To Counter - 1
xMyFile = DirectoryListArray(x)
txtDosyaAdi = Split(xMyFile, "_")
' split() parçalara ayırır, her "_" bölme noktasıdır. 3 tane "_" var 4e böler _
"AYSE_2019_01_KDV" _
1 - txtDosyaAdi(0)==> AYSE isim _
2 - txtDosyaAdi(1)==> 2019 yıl _
3 - txtDosyaAdi(2)==> 01 ay _
4 - txtDosyaAdi(3)==> KDV tür _
dolayısıyla dosya isimlendirme sisteminiz değişirse kodu bu mantığa göre yeniden oluşturmalısınız
If UBound(txtDosyaAdi) <> 3 Then 'bu kısım eğer 4ten farklı sayıda isim varsa hatalı olduğunu varsayar
HataSay = HataSay + 1
StrHatalar = StrHatalar & vbCrLf & "Hatalı dosya ismi : " & xMyFile & " dosyası taşınamadı." 'taşınamayan dosya adı ve sayısı kayedilir
GoTo 10 'dosya ismi hatalı olduğu için ara basamakları atlayıp sonraki dosyaya geçmeyi sağlar
End If
xKonum = CurrentProject.Path & "\Müşteriler\_Tarananlar\" ' dosyanın şu anki yeri
'________________Klasör yoksa olustur__________
Xhedef = CurrentProject.Path & "\Müşteriler\" & txtDosyaAdi(0) 'hedef konum
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef 'klasör yoksa oluşturur varsa pas geçer
Xhedef = Xhedef & "\" & txtDosyaAdi(3)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" & txtDosyaAdi(1)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" & txtDosyaAdi(2)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" 'asıl hedef konum belirlenir
'________________Klasör yoksa olustur bitti__________
'_______________dosya var mı
n = 1
Do 'bu kısım eğer zaten aynı ada sahip dosya varsa dosya isminin sonuna +1 ekleyerek eski dosyaların üstüne yazılmasını engeller
DosyaAdi = Xhedef & xMyFile & "_" & Replace(Space$(3 - Len(n)), " ", "0") & n & ".pdf" 'isim kontrolu burada yapılır
n = n + 1
Loop Until Dir(DosyaAdi) = ""
'_______________dosya var mı bitti
Name xKonum & xMyFile & ".pdf" As DosyaAdi 'taşıma kısmı "NAME eskikonum & dosyaAdı AS yenikonum&DosyaAdı
TasinanSay = TasinanSay + 1 'sorunsuz taşınan dosya sayısı
DoCmd.RunSQL "insert into 2_Dosya_Link_T (MUSTERI_ADI,DOSYA_LINK) values ('" & _
txtDosyaAdi(0) & "', '#" & DosyaAdi & "#');"
10
Next
'hataSay : hata sayısı eğer hata var ise uyarılar
If HataSay > 0 Then StrHatalar = StrHatalar & vbCrLf & _
"Toplam " & TasinanSay & " dosya sorunsuz taşınmıştır." & _
vbCrLf & _
"Toplam " & HataSay & " dosya taşınamamıştır."
'hataSay :eğer hata yok ise uyarılar
If HataSay = 0 Then StrHatalar = "Toplam " & TasinanSay & " dosya sorunsuz taşınmıştır."
MsgBox (StrHatalar)
