Word dosyası oluşturmak

[tamer42]

Merhabalar;

Açık olan çalışma kitabının da bulunduğu;

klasörün altındaki tüm klasörlerin içerine,

ilgili klasörün adında boş bir word dosyası oluşturacak koda ihtiyacım var,

Ã?rn:
Açık olan dosya "C:\NEW FOLDER\" klasörü altında olsun;

ayrıca, bu klasörün içerisinde;

aaaa
bbbb
cccc
dddd

adında klasörler bulunsun,

buradaki herbir klasörün içerisine kendi adında;

aaaa.doc
bbbb.doc
cccc.doc
dddd.doc

boş word dosyaları oluşturacak.

Þimdiden teşekkürler...İyi Çalışmalar dilerim.

 

[Haluk]

[vb:1:87d802e9d4]Sub Test()
Dim FSO As Object
Dim AllSubFolders, MySubFolder, MyFolder
Dim WdDoc As Object
Dim MyPath As String
MyPath = ThisWorkbook.Path
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = FSO.GetFolder(MyPath)
Set AllSubFolders = MyFolder.SubFolders
For Each MySubFolder In AllSubFolders
MyDoc = MyPath & Application.PathSeparator & MySubFolder.Name & _
Application.PathSeparator & MySubFolder.Name & ".doc"
Set WdDoc = CreateObject("Word.Document")
WdDoc.SaveAs MyDoc
Next
WdDoc.Application.Quit
Set WdDoc = Nothing
Set AllSubFolders = Nothing
Set MyFolder = Nothing
Set FSO = Nothing
End Sub
[/vb:1:87d802e9d4]

 

[tamer42]

İlginize çok teşekkürler...

...........
..........
..........

WdDoc.Application.Quit
Set WdDoc = Nothing
Set AllSubFolders = Nothing
Set MyFolder = Nothing
Set FSO = Nothing
End Sub

WdDoc.Application.Quit

satırında hata verdi,

 

[tamer42]

.............
Dim MyPath As String
MyPath = ThisWorkbook.Path
.....................
.....................

MyPath = ThisWorkbook.Path

satırını

MyPath = ActiveWorkbook.Path yapınca sorun çözüldü,

yeniden teşekkürlerimi bildiririm....

 

[Haluk]

Kodlarda bahsettiğiniz türden bir sorun yok ama, sanırım siz kodun yazılmış olduğu dosya yolunda değil de, açık olan ve o anda aktif olan bir kitabın dosya yolunda bu işi yapmak istiyordunuz.

Neyse, önemli olan sorunun çözülmüş olması ...

 

[tamer42]

Merhabalar;

Aşağıdaki kodda; eğer oluşturulmak istenen dosya ilgili klasörde mevcuttsa pas geçecek şekilde nasıl ayarlayabilirim.

For Each MySubFolder In AllSubFolders
MyDoc = MyPath & Application.PathSeparator & MySubFolder.Name & _
Application.PathSeparator & MySubFolder.Name & ".doc"
Set WdDoc = CreateObject("Word.Document")
WdDoc.SaveAs MyDoc
Next

İyi çalışmalar dilerim...

 

[Haluk]

....
...
        For Each MySubFolder In AllSubFolders
            MyDoc = MyPath & Application.PathSeparator & MySubFolder.Name & _
                    Application.PathSeparator & MySubFolder.Name & ".doc"
            If Dir(MyDoc) = Empty Then
                Set WdDoc = CreateObject("Word.Document")
                WdDoc.SaveAs MyDoc
                WdDoc.Application.Quit
            End If
        Next
....
...