Skip to main content

AccessTr.neT M.


Access İçinden Windows Gezginini Yönetmek

Access İçinden Windows Gezginini Yönetmek

Çözüldü #1
Merhaba Üstadlarım,

Bir Access veritabanı düşünün.
Form üzerindeki bir butona basıldığında;
C:\Müşteriler\_Tarananlar\ klasörü altındaki pdf formatındaki dosyaları tarayıp
(Dosya adı kuralı (MüşteriAdı_Yil_Ay_Turu.pdf) şeklindeki dosyaları bulmalı ve iligili klasör altına taşımalı.)

Eklediğim dosyayı incelediğinizde;
_Tarananlar klasörü altındaki dosyaları, ilgili firmaların altına taşımalıdır.

Örneğin;
ALI_2019_01_KDV.pdf dosyasını C:\Müşteriler\ALI\Kdv\2019\01-Ocak\ altına taşımalı.
ALI_2019_02_BEYANNAME.pdf dosyasını C:\Müşteriler\ALI\Beyanname\2019\02-Şubat\ altına taşımalı.
DEVRIM_2019_03_KDV.pdf dosyasını C:\Müşteriler\DEVRIM\Kdv\2019\03-Mart\ altına taşımalıdır.

Bu taşıma işi bittiğinde ise, linkleri otomatik olarak o kayıtta oluşturmalıdır. Şöyle ki,
Access dosyasından, 2_Dosya_Link_T_F formunu açınız.
Müşteri adı alanına ve Dosya Linki alanına az önce taşımış olduğu dosyaların linkini kaydetmelidir.

Yani,
Müşteri adı alanına ALI     Dosya linki alanına C:\Müşteriler\ALI\Kdv\2019\01-Ocak\ALI_2019_01_KDV.pdf
Müşteri adı alanına ALI     Dosya linki alanına C:\Müşteriler\ALI\Beyanname\2019\02-Şubat\ALI_2019_02_BEYANNAME.pdf
olarak kayıt atmalıdır.

Böyle bir işlem yapabilir miyiz?

Teşekkürler.

.rar Desktop.rar (Dosya Boyutu: 361,89 KB | İndirme Sayısı: 4)
Cevapla
#2
Aşağıdaki kodu dener misiniz?

Kod:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim MyFile As String
Dim txtDosyaAdi() As String

MyFile = Dir$(CurrentProject.Path & "\Müşteriler\_Tarananlar\*.pdf")

Do While MyFile <> ""
xMyFile = MyFile
    MyFile = Dir$
txtDosyaAdi = Split(xMyFile, "_")

xKonum = CurrentProject.Path & "\Müşteriler\_Tarananlar\"

Xhedef = CurrentProject.Path & "\Müşteriler\" & txtDosyaAdi(0)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" & Replace(txtDosyaAdi(3), ".pdf", "")
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 & "\"

Name xKonum & xMyFile As Xhedef & xMyFile
'DoCmd.RunSQL "insert into 2_Dosya_Link_T (MUSTERI_ADI,DOSYA_LINK) values ('" & txtDosyaAdi(0) & "', '" & Xhedef & xMyFile & "');"
Loop


sql kodunu da loop döngüsünün içine eklerseniz sorun kalmaz
tablo ilişkileri kesilip aşağıdaki kodu yazınca sorunsuz çalıştı

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Dim MyFile As String
Dim txtDosyaAdi() As String
'On Error Resume Next

ReDim DirectoryListArray(1000)

MyFile = Dir$(CurrentProject.Path & "\Müşteriler\_Tarananlar\*.pdf")
Counter = 0
Do While MyFile <> ""
    DirectoryListArray(Counter) = MyFile
    MyFile = Dir$
    Counter = Counter + 1
Loop

For x = 0 To Counter - 1
xMyFile = DirectoryListArray(x)
txtDosyaAdi = Split(xMyFile, "_")

xKonum = CurrentProject.Path & "\Müşteriler\_Tarananlar\"

Xhedef = CurrentProject.Path & "\Müşteriler\" & txtDosyaAdi(0)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" & Replace(txtDosyaAdi(3), ".pdf", "")
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 & "\"

Name xKonum & xMyFile As Xhedef & xMyFile

DoCmd.RunSQL "insert into 2_Dosya_Link_T (MUSTERI_ADI,DOSYA_LINK) values ('" & _
              txtDosyaAdi(0) & "', '#" & Xhedef & xMyFile & "#');"
Next

Cevapla
...........
#3
Üstadım,

Yukarıda bahsettiğinzi koddan çok fazla anlayamıyorum. Sağolun, teşekkürler. Zaman ayırıp destek olmuşsunuz. Acaba, 1. mesajdaki uygulamamın içine nereye yazılmasını da bilemediğim için uygulama şansınız var mı? Rica etsem, lütfen...

Ben yine de elimden geleni yapıp dediğiniz şekilde uygulamaya eklemeye çalışacağım. Yüksek ihtimal becerem ama, yine de deneyeceğim.

Cevapla
#4
buton ekleyip onun tıkladığında olayına yazacaksınız

Cevapla
...........
#5
(19/03/2019 17:32)haliliyas Adlı Kullanıcıdan Alıntı: buton ekleyip onun tıkladığında olayına yazacaksınız
Sql kodunu loop döngüsüne yazın dediğiniz şey, append sorgusumu oluşturmalıyım.?
Taşıdoğım dosyalara ait Linkleri müşteriye ait kayıt altındaki tabloya eklemek için yazmam gerekiyor değil mi?

Cevapla
#6
taşımada sorun yok -taşıma kodunu değiştirmek zorunda kaldım öbürü ara ara dosyalar taşındığından hata veriyordu-
ama hem tablonuz ilişkili alan kullandığından hem de pdf dosyalarını isimlendirirken kullandığınız i-I farkı nedeniyle dosya isimlerindeki adlar ile tablonuzdaki adlar uyumsuz olunca hata veriyor.
ekleyeceğiniz butonun koduna aşağıdaki kodu yazıp dener misiniz?
az önceki taşıma kodu sürekli hata veriyordu.

Kod:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Dim MyFile As String
Dim txtDosyaAdi() As String
'On Error Resume Next

ReDim DirectoryListArray(1000)

MyFile = Dir$(CurrentProject.Path & "\Müşteriler\_Tarananlar\*.pdf")
Counter = 0
Do While MyFile <> ""
    DirectoryListArray(Counter) = MyFile
    MyFile = Dir$
    Counter = Counter + 1

Loop

For x = 0 To Counter - 1
xMyFile = DirectoryListArray(x)
txtDosyaAdi = Split(xMyFile, "_")

xKonum = CurrentProject.Path & "\Müşteriler\_Tarananlar\"

Xhedef = CurrentProject.Path & "\Müşteriler\" & txtDosyaAdi(0)
If Dir(Xhedef, vbDirectory) = "" Then MkDir Xhedef
Xhedef = Xhedef & "\" & Replace(txtDosyaAdi(3), ".pdf", "")
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 & "\"

Name xKonum & xMyFile As Xhedef & xMyFile

'DoCmd.RunSQL "insert into 2_Dosya_Link_T (MUSTERI_ADI,DOSYA_LINK) values ('" & _
'              txtDosyaAdi(0) & "', '#" & Xhedef & xMyFile & "#');"
Next

Cevapla
...........

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da