Dosya İsminin Bir Kısmını İhmal Ederek Dosya Kopyalatmak

[peaceseller]

Merhaba,

Daha önce,Excel sayfasında isimlerini listelediğim dosyaları belirtilen klasör diyalog kutusundan seçilen klasörden bulup, yine klasör diyalog kutusundan seçilen bir klasöre kopyalayan bir makro ile ilgili sorular sormuştum. Kodu en altta.

Source = TextBox1.Text & "\" & s1.Cells(i + 4, 2) & ".tif"

satırında
"TextBox1.Text" : klasör konumunu belirtiyor (C:\Belgelerim)
"s1.Cells(i + 4, 2)" : listeden alınan dosya ismini belirtiyor
".tif" : dosyalar tif formatında

benim istediğim; (kullandığım dosya isimleri şu şekilde "81.12540.2112@a.tif", yani noktalarla birlikte 13 haneli rakam grubunun sonuna "@a" , "@b" gibi 2 hane daha ekleniyor) dosyaları son 2 hane hariç ilk 13 hanesi ile listeye gireyim,makro bu dosyaları sadece ilk 13 hanesine bakarak, bu ismi 13 hane ile başlayan dosyaları bularak kopyalasın,son 2 haneyi dikkate almasın. Son iki hane yokmuş gibi çalışsın istiyorum.

Yardımcı olabilirseniz memnun olurum.


Private Sub CommandButton3_Click()
Set s1 = Sheets("Resim")
k = 0
DosyaSayısı = Application.CountA(s1.Columns(2)) - 1
For i = 1 To DosyaSayısı
Source = TextBox1.Text & "\" & s1.Cells(i + 4, 2) & ".tif"
deg = CreateObject("Scripting.FileSystemObject").FileExists(Source)
If deg = False Then GoTo 10
Target = TextBox2.Text & "\" & s1.Cells(i + 4, 2) & ".tif"
FileCopy Source, Target
k = k + 1
yuzde = Round((k / DosyaSayısı) * 100, 0)
s1.Cells(2, 9).Value = "%" & yuzde & " kopyalandı"
GoTo 20
10 BDosyaSayısı = Application.CountA(s1.Columns(4))
s1.Cells(i + 2 + BDosyaSayısı, 4) = s1.Cells(i + 4, 2)
20 Next i
s1.Cells(2, 9).Value = BDosyaSayısı & " dosya bulunamadı"
End Sub

--------------------------------------------------------------------------------

 

[Levent Menteşoğlu]

[vb:1:8eca2893d2]Source = TextBox1.Text & "\" & s1.Cells(i + 4, 2) & ".tif" [/vb:1:8eca2893d2]

Yukarıdaki satırı aşağıdaki ile değiştirerek deneyin.

[vb:1:8eca2893d2]Source = left(TextBox1.Text & "\" & s1.Cells(i + 4, 2),13) & ".tif"[/vb:1:8eca2893d2][/quote]

 

[peaceseller]

Sayın leventm;

Bu şekilde yaptığımda dosya bulamayacaktır. Çünkü klasördeki dosyaların isimleri örnek olarak 83.71601.2447@a.tif şeklindedir.Sizin belirttiğiniz kodu koyarsam 83.71601.2447@a.tif dosyasını değil 83.71601.2447.tif dosyasını arayacak ve doğal olarak bulamayacaktır.

 

[Levent Menteşoğlu]

Ben ilk 13 haneye göre isimlendirdiğinizi düşünmüştüm. Bu durumda isme eklenecek "@a" ifadesini neye göre ekleyecektir.

 

[peaceseller]

kısaca ben excel sayfasına yazdığım 13 hane ile başlayan dosyayı bulsun istiyorum,aslında dosya isimleri 15 hane.Excel in filtre özelliğinin,"ile başlar" seçeneği gibi.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:0107eb641a]Private Sub CommandButton3_Click()
Set s1 = Sheets("Resim")
k = 0
DosyaSayısı = Application.CountA(s1.Columns(2)) - 1
For i = 1 To DosyaSayısı
Source = TextBox1.Text & "\" & s1.Cells(i + 4, 2) & ".tif"
Application.FileSearch.LookIn = TextBox1.Text
Application.FileSearch.FileName = Left(TextBox1.Text & "\" & s1.Cells(i + 4, 2), 13)
deg = Application.FileSearch.Execute(msoSortByNone, msoSortOrderAscending, True)
If deg = 0 Then GoTo 10
Target = TextBox2.Text & "\" & s1.Cells(i + 4, 2) & ".tif"
FileCopy Source, Target
k = k + 1
yuzde = Round((k / DosyaSayısı) * 100, 0)
s1.Cells(2, 9).Value = "%" & yuzde & " kopyalandı"
GoTo 20
10 BDosyaSayısı = Application.CountA(s1.Columns(4))
s1.Cells(i + 2 + BDosyaSayısı, 4) = s1.Cells(i + 4, 2)
20 Next i
s1.Cells(2, 9).Value = BDosyaSayısı & " dosya bulunamadı"
End Sub
[/vb:1:0107eb641a]

 

[peaceseller]

Bu kod dosya bulamıyor. Çünkü aşağıdaki satırda "source" un karşılığı olan bir dosya yok ki, "s1.Cells(i + 4, 2)" değeri dosyanın ilk 13 hanesi,benim arama kriterim sadece,dosya ismi 15 haneli,yanlış mı düşünüyorum?"filesearch" kullanmışsınız,ben bu komutu pek bilmiyorum ama "filesearch" ile bulunan dosyaları, "foundfiles" komutu ile "source" değişkenine atayabilir miyiz acaba?fakat bu komutların kullanımı hakkında bilgim yok,biraz denedim ama olmadı.


Source = TextBox1.Text & "\" & s1.Cells(i + 4, 2) & ".tif"

 

[Levent Menteşoğlu]

Application.FileSearch.FileName = Left(TextBox1.Text & "\" & s1.Cells(i + 4, 2), 13)

Yukarıdaki satırı aşağıdaki gibi değiştirerek deneyin.

Application.FileSearch.FileName = Left(s1.Cells(i + 4, 2), 13)

 

[peaceseller]

FileCopy Source, Target

satırında file not found hatası veriyor. source değişkenini 13 haneli olarak belirttiğimiz için değil mi?dosyalar 13 haneli değil ki bulsun.yanlış mı düşünüyorum,çözemedim.