Dosya Kopyalama Taşıma

[baysevimli]

Arkadaşlar Merhaba,

Benim "C:\Arşiv" klasörümün içinde 1300 civarında PDF uzantılı dosyalarım var. Bütün PDF dosyalarıma 5 haneli rakamlar verilmiş. Örnek olsun Birkaç PDF dosya adı vereyim; 17250_ekler , 19306_ekler , 19400_ek gibi.
Ben istiyorum ki ; Excelde "A"sütunuma yazdığım 5 haneli (örneğin 17250,19306,19400) kodlarımı gidip "C:\Arşiv" içindeki PDF'lerin ilk 5 rakamına göre arayıp bulup "C:\bul" klasörümün içine bir kopyasını alacak.

yardımcı olabilirseniz sevinirim. Teşekkürler

 

[askm]

Aşağıdaki kodları kullanabilirsiniz.Bulamadıklarını kırmızı ile boyuyor.

Sub dasyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Arşiv\"
HedefKlasor = "C:\bul\"
On Error Resume Next
For i = 1 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value & ".pdf"
Cells(i, 1).Interior.ColorIndex = xlNone
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, HedefKlasor & Cells(i, 1).Value & ".pdf"
'DosyaSistemi.MoveFile Dosya, HedefKlasor & Cells(i, 1).Value & ".pdf" dosya taşıma için
Else
Cells(i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub

 

[baysevimli]

Sn. Askm

Test ettim çalışmadı. Exceldeki A sütununa yazdığım 5 haneli değerleri kırmızıya boyadı ama diğer klasöre kopyalamadı

 

[baysevimli]

Sorunu anladım. Benim veriklasörümdeki pdf lerimin adı 5 haneli rakamdan sonra değişiyor. Örneğin 16898_ekler, 17250_ek gibi. Şunu yapmalı makro : benim A sütununa yazdığım 5 ahneli sayıyı gidip veriklsörümün içindeki dosyaların adının ilk 5 hanesine göre arayıp kopyalamalı.

 

[askm]

Aşağıdaki şekilde deneyin.

Sub dasyakopyala1()
   
    Yol = "C:\Arşiv\"
    HedefKlasor = "C:\bul\"
    dosya = Dir(Yol & "*.pdf")
    
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
    Range("A:A").Interior.ColorIndex = xlNone
    Do While dosya <> ""
        For X = 1 To Cells(Rows.Count, 1).End(3).Row
            Cells(X, 2) = Left(dosya, Len(Cells(X, 1)))
            If Cells(X, 2) = Cells(X, 1) Then
  
                DosyaSistemi.CopyFile Yol & dosya, HedefKlasor & dosya & ".pdf"
  
                Exit For
            Else
                Cells(X, 1).Interior.ColorIndex = 6
        
            End If
        Next
        dosya = Dir
    Loop
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[baysevimli]

Askm

Test ettim çalıştı teşekkür ederim. Bir konuda daha yardımınıza ihtiyacım var. Hani A sütununa arattıracağım 5 haneli kodları yazıyordum ya. Şimdi O kodları B sütununa yazdım. A sütununda ise dosyaya vereceğim yeni isimleri yazdım. Yani excelim Şöyle oldu;

A Sütunu B Sütunu
1.Teklif 16898
2.Teklif 17250
3.Teklif 18229
4.Teklif 19092
5.Teklif 19153

İstediğim de şu, B sütununda ki kodlarımı yine gidip bulup hedef klasöre kopyalayacak ama kopyaladığı dosyanın ismini A sütununda o kodun karşısındaki isim ve o kodla değiştirecek. Yani örneğin arşiv klasörümde 16898_ek isimli dosyamı gitti buldu ve hedef klasörüme yapıştırdı diyelim. Hedef klasöre yapıştırırken dosya adını 16898_ekler olarak alıyor o şekilde değilde "1.Teklif_16898" olacak şekilde değiştirsin istiyorum. Yapabilirmiyiz böyle bişey.

 

[askm]

Kodları aşağıdaki şekilde değiştirin.

Sub dasya_kopyalama_ve_isim_ver()
   
    Yol = "C:\Arşiv\"
    HedefKlasor = "C:\bul\"
    dosya = Dir(Yol & "*.pdf")
    
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")

    Do While dosya <> ""
        For X = 1 To Cells(Rows.Count, 2).End(3).Row
            Cells(X, 20) = Left(dosya, Len(Cells(X, 2)))
            If Cells(X, 20) = Cells(X, 2) Then
            yeni_isim = Cells(X, 1).Text & "_" & Cells(X, 2)
                DosyaSistemi.CopyFile Yol & dosya, HedefKlasor & yeni_isim & ".pdf"
  
                Exit For

            End If
        Next
        dosya = Dir
    Loop
    Range(Cells(1, 20), Cells(65000, 20)).ClearContents
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[baysevimli]

Askm
İstediğim gibi oldu. Elinize sağlık, teşekkür ederim.

 

[gorsar]

Kodları alt klasörlederde arama yapabilecek şekilde nasıl düzenleyebiliriz acaba. Benzeri bir durum banada lazım.

 

[hasanyaprak]

Kodları aşağıdaki şekilde değiştirin.

Sub dasya_kopyalama_ve_isim_ver()
  
    Yol = "C:\Arşiv\"
    HedefKlasor = "C:\bul\"
    dosya = Dir(Yol & "*.pdf")
   
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")

    Do While dosya <> ""
        For X = 1 To Cells(Rows.Count, 2).End(3).Row
            Cells(X, 20) = Left(dosya, Len(Cells(X, 2)))
            If Cells(X, 20) = Cells(X, 2) Then
            yeni_isim = Cells(X, 1).Text & "_" & Cells(X, 2)
                DosyaSistemi.CopyFile Yol & dosya, HedefKlasor & yeni_isim & ".pdf"
 
                Exit For

            End If
        Next
        dosya = Dir
    Loop
    Range(Cells(1, 20), Cells(65000, 20)).ClearContents
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Hocam selam,
İlgili kodda B sutununda ki pdf dosya isimlerini T sutununa klasör altındak pdflerden bulup yazmaya çalışıyor ama b sutunundaki isimlerden alakasız bir isim yazıyor nedendir acaba.


Çalıştırdığımda aşağıdaki kod satırında hata gösteriyor.
DosyaSistemi.CopyFile Yol & Dosya, HedefKlasor & yeni_isim & ".pdf"