Word dosyası oluşturmak

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,269
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
[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

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
İ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

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
.............
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,269
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
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

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,269
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Kod:
....
...
        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
....
...
 
Üst