Kapalı word dosyaları nasıl yazdırılır.

[kelkitli]

Değerli Dostlar Selamlar,
Sayın Korhan Ayhan Üstadın yazdığı

Sub DOSYALARI_YAZDIR()
Columns(1).Clear
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder("C:\ExcelOrn\").Files
For Each Dosya In Klasör
If InStr(Dosya.Name, ".xls") > 0 Then
X = X + 1
Cells(X, 1) = Dosya.Name
Workbooks.Open Filename:=Dosya
Dim Sayfa As Worksheet
For Each Sayfa In Worksheets
Sayfa.PrintOut
Next
ActiveWorkbook.Close True
End If
Next
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

kodlarla bir dosya içerisindeki excel dosyaları yazdırılabiliyor.
Konu olan dosyalar word dosyası olsaydılar nasıl bir değişiklik gerekirdi.
Ayrıca bu dosyaları yazdırdıktan sonra klasörü temizlemem gerekiyor. Daha sonra gelecek dosyalar için.

 

[leumruk]

Sub Çalıştır()
Set wrd = CreateObject("word.document")
wrd.Application.Documents.Open ("C:\test.doc")
Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument
WDApp.PrintOut
WDApp.Quit
End Sub

Syn. Kelkitli.
Yukarıdaki kodu deneyin.

 

[leumruk]

Syn. Kelkitli,
Yukarıda yazdığım kod işinize yaramadıysa, bir de şunu deneyin.

Sub AutoOpen()
ActiveDocument.PrintOut
End Sub

Yalnız bunu excele değil, worde kopyalayacaksınız. Ortak kod bölümüne.
UYARI: Açılan tüm word dosyalarını yazdırır. Kapat kodu da eklenebilir fakat; bir daha word dosyası açamazsınız.
Yani kod sakıncalı. Eğer belli şartlara bağlayabilirseniz. İşinizi kökünden çözebilir. Excele ihtiyacınız kalmaz.

 

[kelkitli]

Sayın Ieumruk,
Cevaplarınız için teşekkür ederim. Şöyle bir ayrıntı var. ("C:\Downloads\").Files
Bu dosyada olan adı ne olursa olsun eğer .doc uzantılı ise yazdırlmalı. Word içerisinden kod yazmadan diğer (excelde hazırladığım dosyadan) bu işlemi yapabilmem daha uygun olur. Zaten hazırlamakta olduğum dosya işleme başlarken "Downloads" isimli klasör boş oluyor (olmalı). İşlem sırasında web üzerinden word dökümanı indiriliyor. Benim istediğimde indirilen dosyayı (her seferinde ismi farklı) yazdırıp silip işlemi bitirmek.

 

[kelkitli]

Değerli Dostlar, bu word dökümanlarıyla ilgili makro web de çok az bulunuyor. Bu neden böyle anlamadım. Talep azlığındanmı? Dolayısıyla çözüm hususunda zorlanıyoruz. Konuyla ilgilenilirse çok makbule geçer.

 

[kelkitli]

Selamlar,
Sayın leumruk, teşekkür ederim.
Eklediğiniz kodlarla meseleyi şu şekilde çözümledim.
C:\Dovnload isimli dosyada değişik isimle web den gelen tekdosyayı yeniden isimlendirdim.

Sub addegistir()
On Error Resume Next
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Downloads\").Files
c = c + 1
Name "C:\Downloads\" & dosya.Name As "C:\Downloads\" & c & ".doc"
Next
End Sub

Eklediğiniz kod ile yazdırdım.

Sub Çalıştır()
On Error Resume Next
Set wrd = CreateObject("word.document")
wrd.Application.Documents.Open ("C:\Downloads\1.doc")
Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument
WDApp.PrintOut
WDApp.Quit
End Sub

Dosyayı temizledim çıktım.

Sub Killfile()
On Error Resume Next
Dim MyFile As String 'This line of code is optional
On Error Resume Next 'On hitting errors, code resumes next code
MyFile = "c:\downloads\*.doc"
Kill MyFile
End Sub

Ayrıca Sayın Vurala ait kodlarla da bu işlemi yapıyorum.

Sub DOSYALARI_YAZDIR()
Dim klasör As object, dosyam As object
Dim yol As String, wr As object
yol = "c:\downloads"
Set klasör = createobject("Scripting.FileSystemObject")
Set dosyam = klasör.GetFolder(yol).Files
For Each dosya In dosyam
If InStr(dosya.Name, ".doc") > 0 Then
ad = dosya.Path
Set wr = createobject("Word.Application")
Dim docum As Word.Documents
Set docum = wr.Documents
docum.Open ad ', Visible:=False
docum.Item(1).PrintOut
Exit For
End If
Next
docum.Close
wr.Quit
Set docum = Nothing
Set wr = Nothing
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

Katkısı olan herkese teşekkür ederim.