• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Astalavista58

Astalavista58

Katılım
20 Ocak 2020
Mesajlar
247
Excel Vers. ve Dili
Office 2016 TR 64 Bit
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
 
VBA tarafında aktif yılı aşağıdaki komutla elde edebilirsiniz.

Year(Date)
 
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
 
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.
 
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
 
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..

"\"
 
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
 
"\""" böyle olmamalı..

Sondaki iki adet çift tırnağı silerek deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst