VBA|Seviye|Temel
1. Excel Dosyasının Dizini (ThisWorkbook)
Çalışma kitabının bulunduğu dizin aşağıdaki şekilde elde edilebilir.
Private Sub CommandButton1_Click() MsgBox ThisWorkbook.Path End Sub
Çalışma kitabının ismi ve dosya uzantısı ise aşağıdaki şekilde elde edilebilir.
Private Sub CommandButton1_Click() 'MsgBox ThisWorkbook.Path MsgBox ThisWorkbook.FullName End Sub
2. Dosya Adı ve Uzantısı
Dosyanın adı ve uzantısı ise (solundaki dizin ifadeleri olmadan) “String-Metin Değişkeni” isimli makalede anlatılan metotlardan yararlanılarak aşağıdaki şekilde elde edilebilir.
Private Sub CommandButton1_Click() Dim StrFullPath As String, SlashPos As Integer, StrWbName As String 'MsgBox ThisWorkbook.Path 'MsgBox ThisWorkbook.FullName StrFullPath = ThisWorkbook.FullName SlashPos = InStrRev(StrFullPath, "\") 'Sonucu 44 'MsgBox Len(StrFullPath) 'Sonucu 65 'MsgBox Len(StrFullPath) - SlashPos 'Sonucu 21 StrWbName = Mid(StrFullPath, SlashPos + 1, Len(StrFullPath) - SlashPos) MsgBox StrWbName, vbOKOnly, "ishakkutlu.com" End Sub
StrFullPath değişkeni çalışma kitabının/dosyanın (ismi ve uzantısı ile birlikte) tam dizin adını, SlashPos değişkeni ise StrFullPath değişkeninin sağdan ilk “\” karakterinin konumunu (44) verir. StrWbName ise bir Mid metoduna eşitlenmiş olup StrFullPath içinde, (en sağdaki) “\” karakterden sonraki 21 karakteri, yani dosyanın uzantısı ile birlikte adını verir.
Sadece dosyanın adı veya sadece dosyanın uzantısı ise aşağıdaki şekilde elde edilebilir.
Private Sub CommandButton1_Click() Dim StrFullPath As String, SlashPos As Integer, StrWbName As String Dim StrOnlyWbName As String, StrOnlyWbExt As String, DotPos As Integer 'MsgBox ThisWorkbook.Path 'MsgBox ThisWorkbook.FullName 'Dosya adı ve uzantısı StrFullPath = ThisWorkbook.FullName SlashPos = InStrRev(StrFullPath, "\") 'Sonucu 44 'MsgBox Len(StrFullPath) 'Sonucu 65 'MsgBox Len(StrFullPath) - SlashPos 'Sonucu 21 StrWbName = Mid(StrFullPath, SlashPos + 1, Len(StrFullPath) - SlashPos) MsgBox StrWbName, vbOKOnly, "ishakkutlu.com" '_____________ DotPos = InStrRev(StrWbName, ".") 'Sonucu 17 'Sağdan ilk nokta 'MsgBox Len(StrWbName) 'Sonucu 21 'MsgBox Len(StrWbName) - DotPos 'Sonucu 4 'Dosya Adı StrOnlyWbName = Mid(StrWbName, 1, DotPos - 1) 'Veya aşağıdaki satır ile bulunabilir. 'StrOnlyWbName = Left(StrWbName, DotPos - 1) MsgBox StrOnlyWbName, vbOKOnly, "ishakkutlu.com" 'Dosya Uzantısı (noktadan sonra) StrOnlyWbExt = Mid(StrWbName, DotPos + 1, Len(StrWbName) - DotPos) 'Veya aşağıdaki satır ile bulunabilir. 'StrOnlyWbExt = Right(StrWbName, Len(StrWbName) - DotPos) MsgBox StrOnlyWbExt, vbOKOnly, "ishakkutlu.com" End Sub
Bir önceki prosedürde, StrWbName değişkeni ile temsil edilen dosya adı ve uzantısı “Object Değişkeni.xlsm” olarak elde edilmişti. StrWbName değişkeninde sağdan aratılacak ilk nokta, daima dosya uzantısı ile dosya adını ayıran sınırdır. Bu bilgi ile dilerseniz Mid, dilerseniz Left-Right metodu ile dosya adını ve dosya uzantısını ayrıştırabilirsiniz.
3. Dinamik Dosya Dizini Oluşturmak
Bir uygulama yapmak istediğinizi varsayın. Bu uygulamada kodların bulunduğu Excel dosyası dışında, Test isimli başka bir Excel dosyası da yer alsın. Yukarıda da bahsedildiği gibi bir dosyanın dizini, kullanıcı adına, kullanıcının onu C veya D sürücüsünden veya bir ağdan çalıştırmasına bağlı olarak sürekli değişkenlik gösterecektir. Bu durumda yazılan kodların sağlıklı bir şekilde çalışması için her koşula göre algoritmanın dizinlerinde değişiklik yapılması gerekir. “Workbook ve Worksheet Nesneleri-1” isimli makalede yer alan Open Metodu konusunda kullanıcı isminin değiştirilmesinin gerekmesi, söz konusu dizinin dinamik olmamasından kaynaklanmaktadır. Dinamik dizin ile ifade edilmek istenen, söz gelimi Test isimli dosya hangi kullanıcı tarafından açılmak istenirse istensin, kod dizinlerinde herhangi bir değişiklik yapılmadan işlemin gerçekleştirilmesidir.
Söz gelimi masaüstünde Örnek Uygulama isimli bir klasör oluşturun. Bu klasörün içine de Uygulama Dosyaları isimli başka bir klasör açın ve Test isimli Excel dosyasını Uygulama Dosyaları isimli klasörün içine taşıyın. Kodların bulunduğu Excel dosyasını (örnekte Object Değişkeni isimli dosyayı) da Örnek Uygulama isimli klasörün içine taşıyın. Ekran görüntüleri aşağıdadır.
Dinamik dizine ilişkin örnek algoritma aşağıdadır.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String Dim StrFileName As String, StrTestPath As String Application.ScreenUpdating = False Application.DisplayAlerts = False PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak MsgBox PathFinder, vbOKOnly, "ishakkutlu.com" StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. MsgBox StrUygPath, vbOKOnly, "ishakkutlu.com" StrFileName = "Test.xlsx" StrTestPath = StrUygPath & StrFileName 'Nihai olarak Test dosyasının bulunduğu dizin MsgBox StrTestPath, vbOKOnly, "ishakkutlu.com" Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Özetle “Uygulama Dosyaları” isimli klasör ise daima kodların bulunduğu dizinde olmak koşuluyla, kodların bulunduğu Excel dosyasının dizini referans alınarak, kodlarda herhangi bir değişiklik yapılmasına gerek kalmadan “Uygulama Dosyaları” isimli klasörde yer alan Test isimli Excel dosyasına ulaşılabilir. Konuyla ilgili örnek uygulama olması için aşağıdaki kodları inceleyebilirsiniz.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String
Dim StrFileName As String, StrTestPath As String
Dim WsTest As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör.
StrFileName = "Test.xlsx"
StrTestPath = StrUygPath & StrFileName 'Nihai olarak Test dosyasının bulunduğu dizin
Workbooks.Open (StrTestPath) 'Önce Test dosyasını aç
Set WsTest = Workbooks(StrFileName).Worksheets(1) 'Test dosyasının ilk sayfasını bir sayfa değişkenine ata
WsTest.Range("A1").Value = "ishakkutlu.com" 'Test dosyasının ilk sayfasının A1 hücresine ishakkutlu.com yaz
Workbooks(StrFileName).Close SaveChanges:=True 'Test dosyasını kaydedip kapat
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End SubYukarıdaki örnekte “Örnek Uygulama” isimli klasörü bir bütün olarak taşıdığınızda, kodlarınız C, D, ağ, kullanıcı adı vb. herhangi bir dizin farklılığı durumunda da sorunsuz olarak çalışacaktır.
4. Bir Klasörün ve Dosyanın Varlığını Kontrol Etmek
Yukarıdaki prosedür çalıştırıldığında, eğer “Uygulama Dosyaları” isimli klasör yoksa veya ismi (örneğin “Uygulama Dosyaları X” gibi) değiştirilmiş ise aşağıdaki gibi hata mesajı görüntülenir.
Karşılaşılacak hata kodu:
Run-time error ’1004’:
Debug butonuna tıklarsanız hatalı satıra yönlendirilirsiniz.
Bu sebeple hatanın oluştuğu satırın üstünde uygun bir yerde, “Uygulama Dosyaları” isimli klasörün ve onun içinde de Test isimli Excel dosyasının olduğunu kontrol eden komutlar eklememiz gerekir.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String
Dim StrFileName As String, StrTestPath As String
Dim WsTest As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör.
StrFileName = "Test.xlsx"
StrTestPath = StrUygPath & StrFileName 'Nihai olarak Test dosyasının bulunduğu dizin
'Uygulama Dosyaları isimli klasör var mı?
If Not Dir(StrUygPath, vbDirectory) <> vbNullString Then
MsgBox StrUygPath & " dizinine ulaşılamıyor. Bu dizine ait Uygulama Dosyaları isimli klasörün adında değişiklik yapılmış veya Uygulama Dosyaları isimli klasör silinmiş olabilir.", vbOKOnly + vbExclamation, "ishakkutlu.com"
GoTo Son
End If
'Uygulama Dosyaları klasörünün içinde Test isimli (.xlsx uzantılı) Excel dosyası var mı?
If Not Dir(StrTestPath, vbDirectory) <> vbNullString Then
MsgBox StrTestPath & " dizinine ulaşılamıyor. Bu dizine ait klasörlerin ve/veya dosyaların isimlerinde değişiklik yapılmış olabilir.", vbOKOnly + vbExclamation, "ishakkutlu.com"
GoTo Son
End If
Workbooks.Open (StrTestPath) 'Önce Test dosyasını aç
Set WsTest = Workbooks(StrFileName).Worksheets(1) 'Test dosyasının ilk sayfasını bir sayfa değişkenine ata
WsTest.Range("A1").Value = "ishakkutlu.com" 'Test dosyasının ilk sayfasının A1 hücresine ishakkutlu.com yaz
Workbooks(StrFileName).Close SaveChanges:=True 'Test dosyasını kaydedip kapat
Son:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub“Uygulama Dosyaları” isimli klasör bulunamaz ise derleyici If koşulunun içine girerek aşağıdaki mesajı görüntüleyecektir.
Mesajın kapatılması sonrasında ise derleyici GoTo Son komutu sebebiyle, sonraki hiçbir satırı okumadan doğrudan “Son:” işaretinin yer aldığı satıra gidecektir. Ancak “Son:” işaretinden sonraki (varsa) satırlar derleyici tarafından okunacaktır.
Benzer şekilde “Uygulama Dosyaları” isimli klasör ismi bulunmakla birlikte, Test isimli Excel dosyası (“Test X” olarak değiştirildiği varsayımında) bulunamaz ise aşağıdaki mesaj görüntülenecektir.
5. Bir Klasörün İçindeki Dosyanın Kopyalanması ve Adının Değiştirilmesi
“Uygulama Dosyaları” isimli klasörün içinde yer alan “Test” isimli Excel dosyasını aynı klasörün içine kopyalamak ve adını değiştirmek için aşağıdaki algoritmaları inceleyebilirsiniz.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String
Dim StrFileName As String, StrTestPath As String
Dim WsTest As Worksheet, fso As Object, StrNewFileName As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör.
StrFileName = "Test.xlsx"
StrTestPath = StrUygPath & StrFileName 'Nihai olarak Test dosyasının bulunduğu dizin
'Dosyayı kopyala ve adını değiştir
StrNewFileName = "Yeni Test Dosyası.xlsx"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile (StrTestPath), StrUygPath & StrNewFileName, True
'Yeni dosyanın Sayfa1'deki A2 hücresine ishakkutlu.com yaz.
Workbooks.Open (StrUygPath & StrNewFileName) 'Yeni Test Dosyası isimli dosyayı aç
Set WsTest = Workbooks(StrNewFileName).Worksheets(1) 'İlgili dosyanın ilk sayfasını bir sayfa değişkenine ata
WsTest.Range("A2").Value = "ishakkutlu.com" 'İlgili dosyanın ilk sayfasının A2 hücresine ishakkutlu.com yaz
Workbooks(StrNewFileName).Close SaveChanges:=True 'Test dosyasını kaydedip kapat
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End SubProsedürü çalıştırdıktan sonra “Uygulama Dosyaları” isimli klasörün içinde “Yeni Test Dosyası” isimli bir Excel dosyası daha göreceksiniz. Ayrıca söz konusu dosyanın ilk sayfasının A2 hücresinde “ishakkutlu.com” yazdırılmış olduğunu göreceksiniz.
6. Bir Klasörün İçindeki Dosya Adının Değiştirilmesi
Bir dosyanın sadece adını değiştirmek için aşağıdaki algoritmayı inceleyebilirsiniz.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String Dim PreName As String, NextName As String PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. 'Dosyanın adını değiştir PreName = StrUygPath & "Yeni Test Dosyası.xlsx" NextName = StrUygPath & "Test Yedeği.xlsx" Name PreName As NextName End Sub
7. Bir Klasörün İçindeki Belirli Bir Dosyayı Silmek
Bir klasörün içindeki sadece belirli bir dosyayı silmek için “Kill” komutunu aşağıdaki şekilde kullanabilirsiniz.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String Dim PreName As String, NextName As String PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. 'Belirli bir dosyayı sil NextName = StrUygPath & "Test Yedeği.xlsx" Kill NextName End Sub
Ancak butona ikinci kez tıkladığınızda, dosyayı bir önceki tıklamada sildiği için bulamayacağından aşağıdaki gibi bir hata görüntülenir.
Karşılaşılacak hata kodu ve metni:
Run-time error ’53’:
File not found
Debug butonuna tıklarsanız hatalı satıra yönlendirilirsiniz.
Problem yukarıda da belirtildiği gibi “Test Yedeği” isimli dosyanın ilgili klasörde bulunamamasından kaynaklanmaktadır. Daha önce de belirtildiği gibi hatanın oluştuğu satırın öncesine On Error Resume Next, sonrasına ise On Error GoTo 0 komutları eklenerek sorun çözülür.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String Dim PreName As String, NextName As String PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. 'Belirli bir dosyayı sil NextName = StrUygPath & "Test Yedeği.xlsx" On Error Resume Next Kill NextName On Error GoTo 0 End Sub
8. Bir Klasörün İçindeki Belirli Bir Uzantıya Sahip Dosyaları Silmek
“Uygulama Dosyaları” isimli klasörün içinde (.txt uzantılı) standart bir metin dosyası oluşturup herhangi bir isim veriniz. Örnekte söz konusu metin dosyasına “Text Dosyası” ismi verilmiştir. “Uygulama Dosyaları” isimli klasörün içinde birden fazla Excel dosyası ve en az bir adet de metin dosyası olsun. Klasörün içinin temsili görünümü aşağıdaki gibi olacaktır.
Yukarıdaki klasörde yer alan Excel dosyalarının tümünün silinmesini, Excel dışındaki dosyaların ise silinmemesini istediğimizi varsayalım. Bu durumda aşağıdaki komut satırından yararlanılır.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. ‘Tüm xlsx uzantılı Excel dosyalarını sil On Error Resume Next Kill StrUygPath & "*.xlsx" On Error GoTo 0 End Sub
Prosedürün çalıştırılması sonrası ilgili klasörün içinin görünümü aşağıdadır.
Kill komutunun StrUygPath dizininden sonra gelen “*.xlsx” ifadesi, ilgili klasörde yer alan “xlsx” uzantılı tüm dosyaların silinmesini temsil eder.
9. Bir Klasörün İçindeki Tüm Dosyaları Silmek
Herhangi bir dosya tipi gözetmeksizin bir klasörün içindeki tüm dosyaların silinmesi için yukarıdaki algoritmayı aşağıdaki şekilde revize etmeniz yeterli olacaktır.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. 'Tüm xlsx uzantılı Excel dosyalarını sil On Error Resume Next Kill StrUygPath & "*.????" On Error GoTo 0 End Sub
Kill komutunun dosya uzantısının belirtildiği kısma “????” işaretlerini eklemek ilgili klasörde bulunan herhangi bir uzantı tipine sahip dosyaların silineceğini ifade eder.
10. Bir Klasörün İçindeki Dosya Sayısını veya Boş Olup Olmadığını Öğrenmek
Bir klasörün içindeki dosya sayısı veya klasörün boş olup olmadığı aşağıdaki şekilde öğrenilebilir
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String Dim StrFileControl As String, MyCount As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. MyCount = 0 On Error Resume Next StrFileControl = Dir(StrUygPath & "*.???") Do While StrFileControl <> "" MyCount = MyCount + 1 StrFileControl = Dir() Loop On Error GoTo 0 If MyCount > 0 Then MsgBox "Uygulama Dosyaları isimli klasörde toplam " & MyCount & " adet dosya var.", vbOKOnly + vbInformation, "ishakkutlu.com" Else MsgBox "Uygulama Dosyaları isimli klasörde herhangi bir dosya tespit edilemedi.", vbOKOnly + vbInformation, "ishakkutlu.com" End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
11. Bir Klasör Oluşturmak ve İsimlendirmek
VBA ile bir klasör oluşturmak ve onu isimlendirmek için aşağıdaki yöntemden yararlanılabilir.
Private Sub CommandButton1_Click() Dim PathFinder As String, StrUygPath As String, StrNewFolder1 As String, StrNewFolder2 As String Application.ScreenUpdating = False Application.DisplayAlerts = False PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör. StrNewFolder1 = StrUygPath & "Test Klasörü" StrNewFolder2 = StrUygPath & Format(Now(), "ddmmyyyyhhmmss") 'Klasör adı, klasörün oluşturulduğu gün, ay, yıl, saat, dakika ve saniye olacak. MkDir StrNewFolder1 MkDir StrNewFolder2 Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Uygulama Dosyaları isimli klasörün içinde oluşturulan 2 farklı klasöre ilişkin ekran görüntüsü aşağıdadır.
Aynı dizinde ve aynı isimde ikinci bir klasör oluşturmak isterseniz aşağıdaki gibi bir hata kodu alırsınız.
Karşılaşılacak hata kodu ve metni:
Run-time error ’75’:
Path/File access error
Debug butonuna tıklarsanız hatalı satıra yönlendirilirsiniz.
12. Bir Klasörü Silmek/Kaldırmak
VBA ile bir klasörü silmek veya kaldırmak için aşağıdaki yöntem kullanılabilir.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String, StrNewFolder1 As String, StrNewFolder2 As String
Dim fso As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör.
StrNewFolder1 = StrUygPath & "Test Klasörü"
StrNewFolder2 = StrUygPath & Format(Now(), "ddmmyyyyhhmmss") 'Klasör adı, klasörün oluşturulduğu gün, ay, yıl, saat, dakika ve saniye olacak.
'MkDir StrNewFolder1
'MkDir StrNewFolder2
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder StrNewFolder1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub“Uygulama Dosyaları” isimli klasörün içinde yer alan “Test Klasörü” isimli klasörün silinmesine ilişkin ekran görüntüsü aşağıdadır.
Eğer silinmek istenen klasör bulunamaz (yani yok) ise aşağıdaki gibi bir hata kodu alırsınız.
Karşılaşılacak hata kodu ve metni:
Run-time error ’76’:
Path not found
Debug butonuna tıklarsanız hatalı satıra yönlendirilirsiniz.
Bu sorunu çözmek için hatanın oluştuğu satırın hemen üstüne On Error Resume Next, hemen altına da On Error GoTo 0 komutunu ekleyebilirsiniz.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String, StrNewFolder1 As String, StrNewFolder2 As String
Dim fso As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları\" 'Uygulama Dosyaları ise kodlardan yöneteceğimiz dosyaların bulunduğu klasör.
StrNewFolder1 = StrUygPath & "Test Klasörü"
StrNewFolder2 = StrUygPath & Format(Now(), "ddmmyyyyhhmmss") 'Klasör adı, klasörün oluşturulduğu gün, ay, yıl, saat, dakika ve saniye olacak.
'MkDir StrNewFolder1
'MkDir StrNewFolder2
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder StrNewFolder1
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub13. Bir Klasörün İçindekileri veya Kendisini Başka Bir Klasörün İçine Kopyalamak
“Uygulama Dosyaları” isimli klasörün içindeki tüm dosya ve klasörlerin kopyalanacağı, ancak hedef klasörün olmadığı varsayılmıştır. Bu durumda “Uygulama Dosyaları” isimli klasörün içindeki ögelerin, “Hedef Klasör” isimli bir hedef klasör oluşturularak içine kopyalanması aşağıdaki şekilde yapılabilir.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String, StrDestFolder As String
Dim fso As Object
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları"
StrDestFolder = PathFinder & "\Hedef Klasör" 'Hedef Klasör içine Uygulama Klasörü isimli klasörün içindeki dosya ve klasörler kopyalanır.
'StrDestFolder = PathFinder & "\Hedef Klasör\" 'Hedef Klasör içine Uygulama Klasörü isimli klasörün kendisi kopyalanır.
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder StrUygPath, StrDestFolder
End SubProsedür çalıştırılmadan önce ekran görüntüsü şu şekildedir.
Prosedür çalıştırıldıktan sonraki ekran görüntüsü aşağıdadır.
Hedef klasörün içine, “Uygulama Dosyaları” isimli klasörün içinde bulunan tüm dosya ve klasörler kopyalanmıştır. Ekran görüntüsü şu şekildedir.
Yukarıdaki algoritmada yorun satırı yapılarak kapatılan ve sonu “\” ile biten satır kullanılsaydı, hedef klasörün içine, “Uygulama Dosyaları” isimli klasörün kendisi kopyalanmış olurdu. Temsili ekran görüntüsü ise aşağıdadır.
“Uygulama Dosyaları” isimli klasörün kopyalanacağı ve hedef klasörün olduğu varsayılmıştır. Bu durumda “Uygulama Dosyaları” isimli klasörün “Var Olan Klasör” isimli daha önce oluşturulmuş klasörün içine kopyalanması tıpkı yukarıda olduğu gibi yapılabilir.
Private Sub CommandButton1_Click()
Dim PathFinder As String, StrUygPath As String, StrDestFolder As String
Dim fso As Object
PathFinder = ThisWorkbook.Path 'Kodların bulunduğu dosyanın dizini bize referans olacak
StrUygPath = PathFinder & "\Uygulama Dosyaları"
StrDestFolder = PathFinder & "\Var Olan Klasör" 'Var Olan Klasör içine Uygulama Klasörü isimli klasörün içindeki dosya ve klasörler kopyalanır.
'StrDestFolder = PathFinder & "\Var Olan Klasör\" 'Var Olan Klasör içine Uygulama Klasörü isimli klasörün kendisi kopyalanır.
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder StrUygPath, StrDestFolder
End SubÖzetle bir klasörün kendisini veya içindeki dosya ve klasörleri, hedef klasör olsun ya da olmasın yukarıdaki aynı komutlar ile hedef klasörün içine kopyalayabilirsiniz. Eğer hedef klasör yoksa, yukarıda gösterildiği gibi komutlar hedef klasörü otomatik olarak oluşturacaktır.
İshak Kutlu, VBA Notları
