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

[Astalavista58]

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.

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

 

[Korhan Ayhan]

İnceleyiniz.

Sorgu için arama sonuçları: MkDir

www.excel.web.tr

 

[Astalavista58]

Teşekkür ederim sayın Korhan hocam, inceleyeceğim

 

[Korhan Ayhan]

VBA tarafında aktif yılı aşağıdaki komutla elde edebilirsiniz.

Year(Date)

 

[Astalavista58]

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.

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]

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]

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

    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]

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]

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.

  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]

"\""" böyle olmamalı..

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

 

[Astalavista58]

"\""" 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.