VBA İle Bulunduğun Yıla Göre Klasör Oluşturma

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
Merhabalar herkese hayırlı haftasonları dilerim. Aşağıdaki kod ile Excel'den Word'e veri aktarıp, istediğim konuma farklı kaydet ile kaydediyorum.

Yapmak istediğim, folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\2022\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & "\" burdaki 2022 yılını dinamik hale getirmek.

Yani 2023 yılına girdiğimizde "folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" bu klasörde 2023 yılı diye klasör var mı yok mu kontrol edip, eğer yoksa 2023 yılı diye klasör oluşturup, kayıtları bundan sonra o klasöre yapmasını istiyorum.

Kod:
Sub üİ()

Dim fso As Object
Dim folPath As String
Dim doc As Word.Document
Dim ss As Integer
Dim sablon As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\1-MATBU SAKIN DEĞİŞİKLİK YAPMA.docx"
ss = Sheets("5HizmetYılıBaşlama").Cells(Rows.Count, "A").End(xlUp).Row


For i = 2 To ss

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("evraktarihi").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("sicil").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("rütbe").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("adisoyadi").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("konu").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("konu1").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("birimi").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("ücretsizizneayrilmatarihi").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("izinsüresi").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("baslamatarihi").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("birimdurumu").Range.InsertAfter Cells(i, 11)

folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\2022\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & "\"

fso.CreateFolder folPath

doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"

Next i

doc.Application.Quit
    
End Sub
 

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
Teşekkür ederim sayın Korhan hocam, inceleyeceğim
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
VBA tarafında aktif yılı aşağıdaki komutla elde edebilirsiniz.

Year(Date)
 

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
Korhan hocam, revize ettiğim kod ile klasörün olup olmadığını kontrol ettirip, eğer yoksa mevcut yıla ait kalsör oluşturabiliyorum.
Ancak, folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) \ " & Cells(i, 2).Value & " - " & Cells(i, 4).Value & " \ "" bu satırda,
Type mismatch hatası alıyorum, tanımlamada mı bir yanlış yapıyorum acaba.

Kod:
Sub BesHizmetYiliGöreveBaslama()

Dim fso As Object
Dim folPath As String
Dim doc As Word.Document
Dim ss As Integer
Dim sablon As String
Dim fdObj As Object

Application.ScreenUpdating = False

Set fdObj = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\1-MATBU ÜST YAZI SAKIN DEĞİŞİKLİK YAPMA.docx"
ss = Sheets("5HizmetYılıBaşlama").Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To ss

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("evraktarihi").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("sicil").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("rütbe").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("adisoyadi").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("konu").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("konu1").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("birimi").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("ücretsizizneayrilmatarihi").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("izinsüresi").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("baslamatarihi").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("birimdurumu").Range.InsertAfter Cells(i, 11)
    
    If fdObj.FolderExists("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date)) Then
    
    
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) \ " & Cells(i, 2).Value & " - " & Cells(i, 4).Value & " \ ""
        fso.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
        
        Else
        
        fdObj.CreateFolder ("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date))
        
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) \ " & Cells(i, 2).Value & " - " & Cells(i, 4).Value & " \ ""
        fso.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
    
    End If

Next i

doc.Application.Quit

Application.ScreenUpdating = True
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ters slash işaretlerini çift tırnak içinde yazmalısınız ve boşluk içermemelidir.

Mesela Year ifadesinden sonraki ters slash gibi.
 

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
Hocam dediğiniz şekilde yaptım, bu sefer fdObj.CreateFolder folPath satırında "Path Not Found" şeklinde hata alıyorum. Halbuki 2022 klasörünü oluşturuyor

Kod:
    If fdObj.FolderExists("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date)) Then
    
    
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) & "\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & " \ """
        fdObj.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
        
        Else
        
        fdObj.CreateFolder ("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date))
        
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) & "\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & " \ """
        fdObj.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
    
    End If
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
folPath tanımlamasındaki sondaki ters slash sembolünü de düzeltmeniz gerekir.

Çift tırnak içinde ve boşluksuz olmalıdır. Aşağıdaki gibi..

"\"
 

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
Hocam onu da düzelttim ancak yine aynı hatayı veriyor, yine de sayenizde çok şey öğrendim, manuel olarak girerim yıl değerini. Çok teşekkür ederim sayın hocam.

Kod:
  If fdObj.FolderExists("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date)) Then
    
    
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) & "\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & "\"""
        fdObj.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
        
        Else
        
        fdObj.CreateFolder ("C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date))
        
        folPath = "C:\Users\Semah\Desktop\ÜCRETSİZ İZİN\5 Hizmet Yılını Doldurduğundan\" & Year(Date) & "\" & Cells(i, 2).Value & " - " & Cells(i, 4).Value & "\"""
        fdObj.CreateFolder folPath
        
        doc.SaveAs2 folPath & Cells(i, 2).Value & " - " & Cells(i, 4).Value & ".docx"
    
    End If
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
"\""" böyle olmamalı..

Sondaki iki adet çift tırnağı silerek deneyiniz.
 

Astalavista58

Altın Üye
Katılım
20 Ocak 2020
Mesajlar
242
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
20-02-2025
"\""" böyle olmamalı..

Sondaki iki adet çift tırnağı silerek deneyiniz.
Hocam kusura bakmayın, basit bir şey için çok zamanınızı aldım, şimdi düzeldi Allah razı olsun sizden, hayırlı akşamlar.
 
Üst