DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub YazdirPDFDosyalari()
Dim hedefKlasor As String
Dim dosyaAdi As String
Dim dosyaYolu As String
Dim FSO As Object
Dim klasorDosyalar As Object
Dim dosya As Object
Dim ilkBesKarakter As String
Dim AcrobatApp As Object
Dim AcrobatDoc As Object
Dim i As Integer
' Hedef klasör
hedefKlasor = "C:\HedefKlasor\"
' Dosya sistemi nesnesi oluştur
Set FSO = CreateObject("Scripting.FileSystemObject")
' Klasördeki dosyaları al
Set klasorDosyalar = FSO.GetFolder(hedefKlasor).Files
' Adobe Acrobat uygulamasını aç
On Error Resume Next
Set AcrobatApp = CreateObject("AcroExch.App")
On Error GoTo 0
' Klasördeki her bir dosyayı tarar
For Each dosya In klasorDosyalar
' Dosya uzantısı .pdf mi kontrol et
If LCase(FSO.GetExtensionName(dosya.Name)) = "pdf" Then
' Dosya adının ilk 5 karakterini al
dosyaAdi = FSO.GetBaseName(dosya.Name)
ilkBesKarakter = Left(dosyaAdi, 5)
' İlk 5 karakterin sayı olup olmadığını kontrol et
If IsNumeric(ilkBesKarakter) Then
dosyaYolu = hedefKlasor & dosya.Name
' PDF dosyasını aç
Set AcrobatDoc = CreateObject("AcroExch.PDDoc")
If AcrobatDoc.Open(dosyaYolu) Then
' Dosyayı yazdır
AcrobatDoc.PrintPagesSilent 0, AcrobatDoc.GetNumPages - 1, 1, False, False
' PDF dosyasını kapat
AcrobatDoc.Close
End If
End If
End If
Next dosya
' Adobe Acrobat uygulamasını kapat
If Not AcrobatApp Is Nothing Then AcrobatApp.Exit
' Temizle
Set AcrobatDoc = Nothing
Set AcrobatApp = Nothing
Set klasorDosyalar = Nothing
Set FSO = Nothing
MsgBox "Yazdırma işlemi tamamlandı.", vbInformation
End Sub