Kapalı klasördeki PDF dosyalarını toplu halde yazdırmak

[1903emre34@gmail.com]

Merhabalar,

Kapalı klasördeki yer alan pdf dosyalarını, yazdırmak için nasıl kod oluşturabiliriz

Kodu çalıştırdığımız zaman; klasör seçimi sorup, (aşağıdaki kodu ile yaptım)

seçtikten sonra pdf dosyalarının yazdırmak

Sub dosya()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[Korhan Ayhan]

Cümleniz düşük olmuş. İfade etmek istediğiniz soru net anlaşılmıyor.

Kapalı dosyalarında yer alan pdf dosyalarını yazdırmak

 

[Asri]

Kapalı klasör ü anlamadım. Ancak anlaşıldığı kadarı ile kod aşağıdaki şekildedir. Menu yü bir butona bağlayabilirsiniz.

Dim secilendizin As String

Sub menu()
   Call Klasor_Sec
   If secilendizin = "" Then
     MsgBox ("Klasör seçimi yapılmadı.")
     Exit Sub
   End If
   Call pdf_yazdir
End Sub

Sub Klasor_Sec()
  Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
  If Not klasor Is Nothing Then
     kaynak = klasor.self.Path
     If InStr(1, kaynak, "{") > 0 Then GoTo atla
     Set klasor = Nothing
     secilendizin = kaynak
  Else
atla:
     secilendizin = ""
  End If
End Sub


Public Sub pdf_yazdir()

    Dim folder As String
    Dim PDFfilename As String
    
    folder = secilendizin & "\"
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    PDFfilename = Dir(folder & "*.pdf", vbNormal)
    While Len(PDFfilename) <> 0
        Print_PDF folder & PDFfilename
        PDFfilename = Dir()
    Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
    'AcroRd32.exe yolunu aşağıdaki şekilde değiştiriniz. Sürüme göre farklılık gösterir.
    Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
End Sub

 

[1903emre34@gmail.com]

Asri bey, teşekkürler

PDF dosyaların yer aldığı klasör seçip, tamam dediğimiz zaman yazdırma işlevini yapmıyor

 

[Asri]

Asri bey, teşekkürler

PDF dosyaların yer aldığı klasör seçip, tamam dediğimiz zaman yazdırma işlevini yapmıyor

Kodun içindeki bu uyarıya dikkat ettiniz mi?
'AcroRd32.exe yolunu aşağıdaki şekilde değiştiriniz. Sürüme göre farklılık gösterir.

 

[1903emre34@gmail.com]

Ustad, haklısınız dikkatimden kaçmış, çok teşekkürler

iyi çalışmalar

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub KLASÖRDEKİ_PDF_DOSYALARINI_YAZDIR()
    Dim Uygulama As Object, Klasör As Object, Dosya As String
    
    Set Uygulama = CreateObject("Shell.Application")
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz !", 1)
    If Klasör Is Nothing Then Exit Sub
    
    Dosya = Dir(Klasör.Self.Path & "\*.PDF")
    
    While Dosya <> ""
        Uygulama.Open (Klasör.Self.Path & "\" & Dosya)
        DoEvents
        Application.DisplayAlerts = False
        Application.SendKeys "^p~", True
        Application.Wait Now + TimeValue("00:00:01")
        Application.DisplayAlerts = True
        Dosya = Dir
    Wend
    
    'Shell "Taskkill /f /im Acrobat*"
    Application.SendKeys "^q", True
    
    Set Klasör = Nothing

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[akayaloglu]

Alternatif;

Option Explicit

Sub KLASÖRDEKİ_PDF_DOSYALARINI_YAZDIR()
    Dim Uygulama As Object, Klasör As Object, Dosya As String
   
    Set Uygulama = CreateObject("Shell.Application")
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz !", 1)
    If Klasör Is Nothing Then Exit Sub
   
    Dosya = Dir(Klasör.Self.Path & "\*.PDF")
   
    While Dosya <> ""
        Uygulama.Open (Klasör.Self.Path & "\" & Dosya)
        DoEvents
        Application.DisplayAlerts = False
        Application.SendKeys "^p~", True
        Application.Wait Now + TimeValue("00:00:01")
        Application.DisplayAlerts = True
        Dosya = Dir
    Wend
   
    'Shell "Taskkill /f /im Acrobat*"
    Application.SendKeys "^q", True
   
    Set Klasör = Nothing

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Elinize sağlık. Lakin dosya içindeki ilk PDF sayfasını otomatik yazdırıyor ama diğer sayfaları otomatik yazdırmıyor. Dosya içindeki tüm sayfaları yazdırma ikmanı var mı?