Soru pdf dosyalarını başka bir klasöre taşıma

[tahsinanarat]

Bir klasör içerisinde tc kimlik numarası isim sicil şeklinde personelin özel güvenlik kimlik bilgileri tutulmaktadır.

Zamanı geçen (eski) özel güvenlik kimlik kartlarını TC kimlik numarasına göre (ilk 11 karaktere göre yada ilk boşluğu kadar olan şeklinde kıssas alınabilir) belirtilen başka bir klasöre kopyalama veya taşımak için ayrı bir kod,

Silmek için ise ayrı bir kod istiyorum.

Konu gayet açık olduğu için örnek dosya hazırlamadım. Yardımcı olabilecek arkadaşlarıma şimdiden teşekkür ediyorum.

 

[Zeki Gürsoy]

Eski ve yeni pdf ler bir arada ise, eski veya yeni olduğu nasıl tespit edilecek? Bu durumda eski kimlik numaralarının bir listesi gerekli.

 

[tahsinanarat]

Hocam eski den maksadım, son kullanma tarihi geçmiş olan özel güvenlik kimlik kartlarının yenisinin pdf dosyasını ile ben değiştiriyorum, buradaki amacım tarihi geçenleri başka bir klasöre taşımak, yerine yenisini ben kopyalayacağım zaten, yani a sütununda belirttiğim tc kimlik numarası ile başlayanları başka birklasöre taşımak istiyorum.

 

[tahsinanarat]

Konu güncel sayın hocalarım.

 

[metehan8001]

Taşımak için:

Sub KlasoreTasi80()
kimlikler = ThisWorkbook.Path & "\Kimlikler\"
eskikimlik = ThisWorkbook.Path & "\Eskikimlik\"

Set fds = CreateObject("scripting.filesystemobject")
Set klasor = fds.GetFolder(kimlikler)

If fds.folderexists(kimlikler) = False Then MsgBox "Kimlikler Klasörü bulunamadı", , "Www.***************": Exit Sub
If fds.folderexists(eskikimlik) = False Then MsgBox "Eskikimlik Klasörü bulunamadı", , "Www.***************": Exit Sub

    For Each dosya In klasor.Files
    uzanti = Trim(Mid(dosya.Name, InStrRev(dosya.Name, ".", -1, 1) + 1))
    If uzanti = "pdf" Then
        For xd = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If Val(Left(dosya.Name, 11)) = Val(Cells(xd, 1)) Then
            fds.movefile dosya.Path, eskikimlik & "\" & dosya.Name
            Exit For
            End If
        Next
    End If
    Next
MsgBox "Belirtilen dosyalar taşındı", vbInformation + vbMsgBoxRtlReading, "ww.***************"
End Sub

Silmek için:

Sub PDFsil80()

eskikimlik = ThisWorkbook.Path & "\Eskikimlik\"

Set fds = CreateObject("scripting.filesystemobject")
Set klasor = fds.GetFolder(eskikimlik)

If fds.folderexists(eskikimlik) = False Then MsgBox "Eskikimlik Klasörü bulunamadı", , "Www.***************": Exit Sub

    For Each dosya In klasor.Files
    uzanti = Trim(Mid(dosya.Name, InStrRev(dosya.Name, ".", -1, 1) + 1))
    If uzanti = "pdf" Then
        For xd = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If Val(Left(dosya.Name, 11)) = Val(Cells(xd, 1)) Then
            Kill eskikimlik & "\" & dosya.Name
            Exit For
            End If
        Next
    End If
    Next
MsgBox "Belirtilen dosyalar Silindi", vbInformation + vbMsgBoxRtlReading, "ww.***************"
End Sub

 

[tahsinanarat]

Sn. metehan8001, her iki kodu uyguladım, tam istediğim sonuç. Çok teşekkür ediyorum. Elinize fikrinize sağlık.

Özellikle taşıma olayı için adres yolunu kod içinde değil de hücre den aldırabilirsek, örneğin e1 hücresine C:\a_grubu\ dediğinizde C dizinine kendisi a_grubu adlı bir klasör açım bu klasöre kopyalayabilirse çok güzel olacak. Teşekkürler

 

[metehan8001]

Rica ederim Tahsin hocam ayrıca belirttiğiniz işlemi aşağıdaki şekilde yapabilirsiniz.
kimlikler = Range("e1") şeklinde olur.

 

[tahsinanarat]

eskikimlik = Range("e1")
MkDir Range("e1")
Bu şekilde yaptım oldu, hocam teşekkürler.

 

[metehan8001]

Iyi çalışmalar hocam