alle pdf documenten in een map printen als xps

Status
Niet open voor verdere reacties.
S

Stief2017

Gebruiker
Lid geworden
3 jan 2017
Berichten
17
Ondanks zoeken op Google is het volgende nog niet gelukt.
Ik wil alle .pdf-documenten uit een map "P:\mijn documenten\test" m.b.v. VBA-code printen met "Microsoft XPS Document Writer".
Graag hulp hierbij. Dacht ik Google het even, maar ik ben al een paar dagen op zoek en het lukt niet.
 
Heb je de macrorecorder al gebruikt ?
 
Nee macrorecorder biedt geen uitkomst. Ik wil PDF-documenten uit een map printen. In Adobe kan je geen macrorecorder gebruiken. Als vanuit Excel macrorecorder wordt gebruikt, dan wordt er geen code opgenomen voor het printen van pdf-documenten uit de map "P:\mijn documenten\test".
 
Dan heb je blijkbaar een Adobe vraag.

Basaal:

Code: 
Shell "AcroRd32.exe /N /T " & PdfFile & "PrinterName [ PrinterDriver [ PrinterPort ]]"
 
Laatst bewerkt:
Nee ik wil de bestanden als .xps opslaan.

De volgende code heb ik gevonden en die print alle .pdf documenten uit de betreffende map, maar de documenten moeten als .xps geprint/opgeslagen worden en dat lukt niet.

Public Sub Print_All_PDF_Files_in_Folder()

Dim folder As String
Dim PDFfilename As String

folder = "p:\mijn documenten\test" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "" Then folder = folder & ""

PDFfilename = Dir(folder & "*.pdf", vbNormal)


While Len(PDFfilename) <> 0
Print_PDF folder & PDFfilename
PDFfilename = Dir() ' Get next matching file
Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
End Sub
 
Het antwoord staat in mijn laatste post.
 
Beste Giga Honourable Senior Member n.a.v. jouw antwoord heb ik het volgende geprobeerd, maar het lukt mij niet.

Public Sub Print_All_PDF_Files_in_Folder()

Dim folder As String
Dim PDFfilename As String

folder = "p:\mijn documenten\test" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "" Then folder = folder & ""

PDFfilename = Dir(folder & "*.pdf", vbNormal)


While Len(PDFfilename) <> 0
Print_PDF folder & PDFfilename
PDFfilename = Dir() ' Get next matching file
Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
Shell "AcroRd32.exe /N /T " & PDFfilename & "Microsoft XPS Document Writer [ Microsoft XPS Document Writer [ XPSPort ]]"
End Sub
 
Mocht het lukken dan zal je waarschijnlijk elke een save-as-dialog krijgen waar je handmatig moet klikken.
Ik denk dat je op zoek moet naar een "silent"-mogelijkheid zonder dialogs.
Google "batch convert pdf to xps" zodat je ziet waaraan je begint.

P.S. kennis over adobe acrobat reader is dungezaaid
 
Laatst bewerkt:
Werkt dit?
Code: 
Shell "AcroRd32.exe /N /T " & PDFfilename & "Microsoft XPS Document Writer"
Rechte haken staan voor opties, nu worden de default waarden gekozen
 
als er spaties in de namen van folders of bestaden staan loopt deze code niet.
Je zult meer info moeten verstrekken.
Zo is de code robuust ivm spaties:

Code: 
Shell "AcroRd32.exe /N /T ""G:\OF\voorbeeld.pdf"" Microsoft XPS Document Writer"

Probeer eerst de code uit met behulp van de fullname van een bestaand bestand.

Met een variabele ziet de code er zo uit:

Code: 
Shell "AcroRd32.exe /N /T """ & "G:\OF\voorbeeld.pdf" & """ Microsoft XPS Document Writer"

Code: 
Shell "AcroRd32.exe /N /T """ & pfdfullname & """ Microsoft XPS Document Writer"
 
Laatst bewerkt:
Zinvolle informatie verstrekken is niet je fort.
 
Ik ben een stap verder. De macro nu in Word geplaatst en ActivePrinter = "Microsoft XPS Document Writer" toegevoegd.
Alle .pdf-documenten uit de map "p:\mijn documenten\test" worden nu afgedrukt als .xps. Er wordt wel telkens om een naam gevraagd die ik handmatig moet opvoeren. Weet iemand hoe ik de bestandsnaam automatisch kan opgeven? De bestandsnaam mag hetzelfde zijn als de naam van het pdf-bestand.

Ik heb geen verstand van de Shell commando: Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus. Er moet nog iets bij als saveas PDFfilename. Graag uw hulp.

Public Sub Print_All_PDF_Files_in_Folder()

Dim folder As String
Dim PDFfilename As String



folder = "p:\mijn documenten\test" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "" Then folder = folder & ""

PDFfilename = Dir(folder & "*.pdf", vbNormal)


While Len(PDFfilename) <> 0
Print_PDF folder & PDFfilename
PDFfilename = Dir() ' Get next matching file
Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
ActivePrinter = "Microsoft XPS Document Writer"

Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
End Sub
 
fort, forte of forté daar gaat het nu niet om. AUB hulp met shell functie om op te slaan als..
 
Werkt bij mij Windows8en, Office2007nl, adobe reader xi nl.
Code is voor nederlandse versie van adobe reader xi, code eventueel aanpassen voor andere talen.
Niet alle pdf's worden netjes omgezet naar xps, het ligt niet aan de code maar aan de "kwaliteit" van de pdf.

Lees ook https://blogs.msdn.microsoft.com/mi...oxps-file-support-in-windows-7-and-windows-8/

"Werkt niet" is een dooddoener, jij bent de ogen en oren van de helpers, vertel wat er gebeurt.

in Module1
Code: 
[SIZE=1]Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private Const BM_CLICK = &HF5
Private Const WM_SETTEXT = &HC

Public Sub Print_All_PDF_Files_in_Folder()

Dim hButton As Long
Dim hEdit As Long
Dim hSaveAs As Long
Dim lngApplication As Long
Dim lngKill As Long
Dim strPDF As String
Dim strPath As String
Dim strXPS As String

    strPath = "P:\mijn documenten\test\"
    
    strPDF = strPath & Dir(strPath & "*.pdf")
    Do While (strPDF <> "")
'        lngApplication = Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /t """ & strPDF & """ ""Microsoft XPS Document Writer""", vbNormalFocus)
        lngApplication = Shell("C:\Program Files\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /t """ & strPDF & """ ""Microsoft XPS Document Writer""", vbNormalFocus)

        Do
'            hSaveAs = FindWindow("#32770", "Printeruitvoer opslaan als") 'eventueel aanpassen "Printeruitvoer opslaan als"
            hSaveAs = FindWindow("#32770", "Save the file as") 'eventueel aanpassen "Printeruitvoer opslaan als"
            DoEvents
            Application.Wait DateAdd("s", 1, Now())
        Loop Until hSaveAs

        hEdit = FindWindowEx(hSaveAs, 0, "DUIViewWndClassName", "")
        hEdit = FindWindowEx(hEdit, 0, "DirectUIHWND", "")
        hEdit = FindWindowEx(hEdit, 0, "FloatNotifySink", "")
        hEdit = FindWindowEx(hEdit, 0, "ComboBox", "")

        strXPS = Split(strPDF, ".")(0) & ".xps"
        
        SendMessageByString hEdit, WM_SETTEXT, 0&, strXPS

'        hButton = FindWindowEx(hSaveAs, 0, "Button", "&Opslaan") 'eventueel aanpassen "&Opslaan"
        hButton = FindWindowEx(hSaveAs, 0, "Button", "&Save") 'eventueel aanpassen "&Opslaan"
        
        SendMessage hButton, BM_CLICK, 0, 0
        
        Do
'            hSaveAs = FindWindow("#32770", "Printeruitvoer opslaan als") 'eventueel aanpassen "Printeruitvoer opslaan als"
            hSaveAs = FindWindow("#32770", "Save the file as") 'eventueel aanpassen "Printeruitvoer opslaan als"
            DoEvents
            Application.Wait DateAdd("s", 1, Now())
        Loop While hSaveAs

        lngKill = lngApplication
        Do
            lngKill = Shell("TaskKill /F /IM ""AcroRd32.exe""")
            DoEvents
            Application.Wait DateAdd("s", 1, Now())
        Loop Until lngKill <> lngApplication

        strPDF = strPath & Dir
        
    Loop

End Sub[/SIZE]
 
Laatst bewerkt:
Ook de laatste code heeft niet het gewenste effect. Ik wil graag alle pdf documenten uit een map automatisch afdrukken als xps bestand. Het is niet de bedoeling dat ik bij elk bestand handmatig een naam voor het xps bestand moet aangeven.Het lijkt een simpele vraag maar tot nu toe heb ik geen vba-code kunnen vinden
om dit te doen.
 
alphamax zei:
"Werkt niet" is een dooddoener, jij bent de ogen en oren van de helpers, vertel wat er gebeurt.
Klik om te vergroten...
Mijn code doet precies wat jij vraagt, wordt er niet minimaal 1 .xps bestand gemaakt?
 
Laatst bewerkt:
Betere code in bericht#16
Werkt ook met Windows7en, Office2007nl, adobe reader DC nl.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan