Bir klasörde ilgili resimleri seçebilmek için düzenli ifadelerden (regular expression) faydalanılan ve bu şekilde taşıma işleminin yapıldığı bir VBA örneğidir.
Klasördeki resim dosyası içerikleri aşağıdaki şekilde:
Ana Resim Dosyası
Ana dosya isimlerinde bir değişiklik yok.
Otomatik Olarak Oluşturulmuş Resimler
Otomatik olarak oluşturulmuş dosyalar var. Bu dosyalar da şuna benzer şekildeler:
bu_bir_dosya_adi-1024x700.pngAmacımız ana resimleri otomatik olarak oluşturulmuş resimlerden ayıklamak. Alternatif bir çözüme bakalım.
Option Explicit
Sub ResimDosyalariniRegularExpressionIleAyikla()
'--------------------------------------------------
'Microsoft VBScript Regular Expressions 5.5
'referansını seç.
'--------------------------------------------------
Dim fso As Object
Dim klasor As Object
Dim dosya As Object
Dim i As Long
Dim sayac As Long
Dim regex As New RegExp
Dim desen As String
Dim ciktiYol As String
Dim kopyalanacakYol As String
Dim hedefYol As String
'--------------------------------------------------
'Değişken atamalarını yap.
'--------------------------------------------------
i = 1
sayac = 1
desen = "([a-zA-Z0-9_]{1,100})([-])([0-9]{1,4})([x])([0-9]{1,4}[.][a-zA-Z]{1,4})"
'--------------------------------------------------
'Nesne örneklerini ayarla.
'--------------------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
Set klasor = fso.GetFolder("C:\OrnekKlasor\ResimIcerikleri")
'--------------------------------------------------
'Listeleme yapılacak sütunu komple temizle.
'--------------------------------------------------
Range("A1:B1048576").Clear
'--------------------------------------------------
'regex değişkenini ayarla.
'--------------------------------------------------
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = desen
End With
'--------------------------------------------------
'Filtre uygulanacak klasördeki dosyaları listele.
'--------------------------------------------------
For Each dosya In klasor.Files
Range("A" & sayac) = dosya.Name
sayac = sayac + 1
Next
'--------------------------------------------------
'İstenilen dosyaları filtrele.
'--------------------------------------------------
sayac = 1
For Each dosya In klasor.Files
If regex.Test(dosya) = False Then
Range("B" & sayac) = dosya.Name
sayac = sayac + 1
End If
Next
'--------------------------------------------------
'Dosyaların kopyalanacağı klasör yolunu ayarla.
'--------------------------------------------------
ciktiYol = klasor & " - Ayıklanan Resimler"
'--------------------------------------------------
'Eğer kopyalanacak klasör yoksa oluştur.
'--------------------------------------------------
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(ciktiYol) Then .CreateFolder ciktiYol
End With
'--------------------------------------------------
'Kopyalama işlemi yap.
'--------------------------------------------------
For i = 1 To Range("B1048576").End(xlUp).Row
kopyalanacakYol = klasor & Application.PathSeparator & Range("B" & i)
hedefYol = ciktiYol & Application.PathSeparator & Range("B" & i)
With CreateObject("Scripting.FileSystemObject")
Call .CopyFile(kopyalanacakYol, hedefYol)
End With
Next
End Sub
Option Explicit
Sub ResimDosyalariniRegularExpressionIleAyikla()
'--------------------------------------------------
'Scripting.FileSystemObject sınıfı örneği
'oluşturmak ve atamak için kullanacağımız
'değişken. Klasördeki dosya listesini almak
'için kullanacağız.
'--------------------------------------------------
Dim fso As Object
'--------------------------------------------------
'fso nesnesi aracılığıyla klasör
'ataması yapacağımız değişken.
'--------------------------------------------------
Dim klasor As Object
'--------------------------------------------------
'fso nesne örneği aracılığıyla
'klasörün içindeki dosya isimlerini
'almak için kullanacağımız değişken.
'--------------------------------------------------
Dim dosya As Object
'--------------------------------------------------
'Döngü için kullanılacak değişken.
'--------------------------------------------------
Dim i As Long
'--------------------------------------------------
'Sayaç olarak kullanacağımız değişken.
'--------------------------------------------------
Dim sayac As Long
'--------------------------------------------------
'Resim dosyalarını elemek için düzenli ifadelerden
'faydalanacağız. Bunu kullanabilmemizi sağlayan
'RegExp nesnesini kullanabilmek için oluşturduğumuz
'değişken.
'
'Bunu kullanabilmek için VBA penceresi menüsünde
'Tools > References seçeneklerini takip edin.
'
'Gelen pencerede aşağıdaki seçeneği
'bulun ve seçin:
'
'Microsoft VBScript Regular Expressions 5.5
'--------------------------------------------------
Dim regex As New RegExp
'--------------------------------------------------
'Regular expression desenini
'atayacağımız değişken.
'--------------------------------------------------
Dim desen As String
'--------------------------------------------------
'Ayıklanmış olan dosyaları aktarmak
'için kullanacağımız hedef klasör
'yolunu atadığımız değişken.
'--------------------------------------------------
Dim ciktiYol As String
'--------------------------------------------------
'Ayıklamak istediğimiz dosyanın
'mevcut yolunun atandığı değişken.
'--------------------------------------------------
Dim kopyalanacakYol As String
'--------------------------------------------------
'Ayıklamak istediğimiz dosyanın
'yeni yolunun atandığı değişken.
'--------------------------------------------------
Dim hedefYol As String
'--------------------------------------------------
'Döngü için kullanılacak değişkene
'başlangıç değeri atadık.
'--------------------------------------------------
i = 1
'--------------------------------------------------
'Sayaç kullanılacak değişkene
'başlangıç değeri atadık.
'--------------------------------------------------
sayac = 1
'--------------------------------------------------
'Regular Expression nesnesine atamak için
'kullanacağımız desen metnini bir değişkene atadık.
'Bu değişkendeki regular expression deseni 7 temel kısımdan oluşuyor.
'
'desen =
'
'Dosyanın isminde büyük-küçük harfler ve sayılar bulunabilir.
'Diğer karakterlerden de "_" karakteri dosya isminde geçebilir.
'Bu dosyanın ismi en az bir karakter en fazla da 100 karakterdir.
'([a-zA-Z0-9_]{1,100})
'Dosya isminin hemen sağında mutlaka bir tire ( "-" ) işareti var.
'([-])
'Tire işaretinden sonra dosya boyutu eklenmiş.
'Genişlik boyutu sadece sayılardan oluşuyor.
'Bu sayı en az bir haneli, en çok da 4 hanelidir.
'([0-9]{1,4})
'Boyutlar çarpı işareti ("x") ile ayrılmış.
'İki boyut arasında mutlaka bir çarpı işareti var.
'([x])
'Yükseklik boyutu sadece sayılardan oluşuyor.
'Bu sayı en az bir haneli, en çok da 4 hanelidir.
'([0-9]{1,4})
'Şimdi dosya uzantısı ile ilgili regex düzenlemesini yapıyoruz.
'Standart olarak uzantılar nokta (".") işareti ile ayrılıyor.
'([.])
'Uzantı sadece büyük-küçük harflerden oluşmaktadır.
'Uzantı en az 1 en fazla 4 karakter uzunluğundadır.
'Örneğin png 3 karakterli iken jpeg 4 karakterlidir.
'([a-zA-Z]{1,4})"
'--------------------------------------------------
desen = "([a-zA-Z0-9_]{1,100})([-])([0-9]{1,4})([x])([0-9]{1,4}[.][a-zA-Z]{1,4})"
'--------------------------------------------------
'Scripting.FileSystemObject nesnesi oluşturduk.
'--------------------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
'--------------------------------------------------
'İşlem yapılacak klasörü ayarladık.
'--------------------------------------------------
Set klasor = fso.GetFolder("C:\OrnekKlasor\ResimIcerikleri")
'--------------------------------------------------
'Listeleme yapılacak sütunu komple temizliyoruz.
'Böylelikle olası bir karışıklığı önlemiş oluyoruz.
'--------------------------------------------------
Range("A1:B1048576").Clear
'--------------------------------------------------
'regex değişkeni için ayarlama yapıyoruz.
'Dikkat ettiyseniz "desen" isimli değişkenimizi
'regex nesne örneğimizin Pattern kısmına atadık.
'--------------------------------------------------
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = desen
End With
'--------------------------------------------------
'Klasördeki tüm dosyaları A sütununda listeliyoruz.
'Bunun için de klasor isimli değişkenden (yani
'arka planda Scripting.FileSystemObject nesnesinden)
'faydalanacağız. Bu kodun özel bir amacı yok,
'sadece tüm dosyaları görebilmek için listeledik.
'--------------------------------------------------
For Each dosya In klasor.Files
Range("A" & sayac) = dosya.Name
sayac = sayac + 1
Next
'--------------------------------------------------
'Klasördeki her dosya için regular expression
'kontrolü yapıyoruz. Bu testi geçen dosyalar
'bizim istemediğimiz dosyalar. Geçemeyen
'dosyalar da bizim ayıklamak istediğimiz dosyalar.
'Eğer dosya testten geçememişse (yani ayıklamak
'istediğimiz bir dosyaysa) B sütunundaki listeye
'ekletiyoruz.
'
'Burada dosyanın sadece ismini listeletiyoruz.
'Tam yolunu değil.
'--------------------------------------------------
sayac = 1
For Each dosya In klasor.Files
If regex.Test(dosya) = False Then
Range("B" & sayac) = dosya.Name
sayac = sayac + 1
End If
Next
'--------------------------------------------------
'Dosyaların kopyalanacağı klasör yolunu ayarlıyoruz.
'Buradaki amacımız hedef klasör de kaynak klasörle
'aynı yerde olsun ama birbirine de karışmasınlar.
'Bu yüzden klasor değişkenindeki klasöre metin
'ekleyerek farklı bir klasör yolu elde etmiş olduk.
'Bu da bizim hedef yolumuz oluyor, yani dosyaları
'kopyalayacağımız klasör.
'--------------------------------------------------
ciktiYol = klasor & " - Ayıklanan Resimler"
'--------------------------------------------------
'Hedef yolu oluşturduk. Şimdi de bu yolu bir
'kontrolden geçirelim. Eğer bu klasör yoksa
'bu klasör oluşturulsun.
'--------------------------------------------------
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(ciktiYol) Then .CreateFolder ciktiYol
End With
'--------------------------------------------------
'B sütununda listelenmiş her dosyayı hedef klasöre
'kopyalayacağız. Bunu da döngü ile yapıyoruz.
'--------------------------------------------------
For i = 1 To Range("B1048576").End(xlUp).Row
'--------------------------------------------------
'Biz dosya isimlerini listeletirken dosyaların
'sadece ismini almıştık. Gel gelelim bu kopyalama
'işleminde dosyanın tam yolu gerekiyor.
'
'Kopyalama işleminin yapılacağı klasör zaten
'klasor isimli değişkende tanımlıydı. Eğer ben
'onu dosya ismiyle düzgün bir şekilde
'birleştirirsem kaynak tam yolu elde
'etmiş olurum.
'
'Aynı şekilde ben zaten yukarıda hedef klasörümü
'oluşturmuştum ve ciktiYol isimli değişkene atamıştım.
'Onu da dosya ismiyle doğru bir şekilde birleştirirsem
'hedef tam yolunu da elde etmiş olurum.
'--------------------------------------------------
kopyalanacakYol = klasor & Application.PathSeparator & Range("B" & i)
hedefYol = ciktiYol & Application.PathSeparator & Range("B" & i)
'--------------------------------------------------
'Dosya kopyalama işlemi için de Scripting.FileSystemObject
'sınıfından faydalanıyoruz. Yukarıda oluşturduğumuz
'iki parametreyi sınıfın CopyFile metodunda kullandık.
'--------------------------------------------------
With CreateObject("Scripting.FileSystemObject")
Call .CopyFile(kopyalanacakYol, hedefYol)
End With
Next
End Sub