Word sayfasını klasörlerin içerisine yapıştırmak

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim ANA VERİ klasör içerisindeki VERİ isimli word sayfam var, bu sayfayı kopyalayıp, ANA VERİ klasör içerisinde bulunan bütün klasörlerin içerisine yapıştırmak.

ANA VERİ klasörü içerisinde klasörlerim çok olduğu için her klasörü tek tek açıp word sayfasını yapıştırmak çok zaman alıyor.

Forumda ve internette araştırdım ancak böyle bir çalışma bulamadım.

Yardımcı olur musunuz?

 

[alicimri]

veri.docx dosyasının yanına bir excel dosyası oluşturun aşağıdaki kodu yapıştırıp çalıştırın.

   Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each objFile In objFolder.Files
For Each objSubFolder In objFolder.subfolders
If Right(objFile.Name, 4) = "docx" Then

FileCopy ThisWorkbook.Path & "\" & objFile.Name, objSubFolder & "\" & objFile.Name
 End If
Next objSubFolder
Next objFile
End Sub

 

[ASLAN7410]

Sayın Ali Bey ilginiz için çok teşekkür ederim.
Sizin dediğiniz gibi yaptım, ancak aşağıdaki kodu sarıya boyuyor.

Küçük bir şey daha isteyebilir miyim? Klasör içerisindeki tüm ismi ne
olursa olsun .docx uzantılı dosyaları bu klasör içerisindeki tüm klasörlere yapıştırabilir mi?

FileCopy ThisWorkbook.Path & "\veri.docx", objSubFolder & "\veri.docx"

 

[tahsinanarat]

Sn. ASLAN7410 ben şimdi denedim, Sn. alicimri Beyin kodları çalışıyor, sedece kod içindeki vord dosyası adı olan veri ismini büyük harf VERİ şeklinde değiştirip deneyiniz, istediğiniz gibi oluyor.

FileCopy ThisWorkbook.Path & "\VERİ.docx", objSubFolder & "\VERİ.docx"

 

[alicimri]

#2 nolu mesajdaki kodları değiştirdim. Tüm "docx" uzantılı dosyalar, bütün alt klasörlere kopyalıyor

 

[ASLAN7410]

Sayın tahsinanarat ilginize çok teşekkür ederim.

Sayın Ali Bey çok teşekkür ederim, ellerinize sağlık tam istediğim gibi oldu.

Hayırlı çalışmalar hayırlı akşamlar.

 

[ASLAN7410]

Merhaba hayırlı geceler, aşağıdaki kodu Sayın Ali Bey hazırladı, gayet güzel çalışıyor.

Butona bastığımda ANA KLASÖR içindeki bütün klasörlere VERİ isimli word sayfamı butonla hepsine toplu olarak yapıştırıyorum.

VERİ isimli word dosyasında bazı değişiklikler yapmam gerektiği için değişiklikler yaptım, butona bastığımda yanıt vermiyor diyerek excel sayfası kilitleniyor.

Bütün klasörleri tek tek açıp içerisindeki VERİ isimli word sayfasını tek tek silmekte zaman alıyor.
Klasörler içinde hepsinde VERİ isimli word sayfam olduğu için kilitlenme oluyor, kod içerisine eskisinin üzerine yaz kodu eklenebilir mi?

Sub PrintFolders1()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each objSubFolder In objFolder.subfolders
FileCopy ThisWorkbook.Path & "\VERİ.docx", objSubFolder & "\VERİ.docx"
Next objSubFolder
End Sub

 

[ASLAN7410]

Sayın arkadaşlar konu günceldir.

 

[alicimri]

Zaten güncellenmiş halini eski halinin üzerine yazıyor. Ama kodu aşağıdaki kod sorununuz çözülür sanıyorum.

Sub PrintFolders1()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each objSubFolder In objFolder.subfolders
If Dir(objSubFolder & "\VERİ.docx") <> Empty Then
Kill objSubFolder & "\VERİ.docx"
End If
FileCopy ThisWorkbook.Path & "\VERİ.docx", objSubFolder & "\VERİ.docx"
Next objSubFolder
End Sub

 

[ASLAN7410]

Sayın Ali Bey ellerinize sağlık çok güzel oldu, tam istediğim gibi çalışıyor, çok teşekkür ediyorum.

 

[ASLAN7410]

Bu mesaj silindi