AW: alle Dokumente aus Ordnern drucken
01.07.2014 14:47:54
fcs
Hallo Stefan,
hier Makros, die im Prinzip funktionieren. Ich hab es mit verschiedenen Dateiformaten (Docx, pdf, tif, ppt, txt, xls) probiert. ca. 3 bis 5 Dateien in 2 Ordnern.
Die Ermiitlung des Ordnernamens aus dem Hyperlink kann Probleme machen, wenn dieser als relativer Link ausgelesen wird.
Bei verschiedenen Programmen kann es zur Anzeige von Dialogfenstern kommen, abhängig von den Einstellungen im Programm; z.B. Aktualisierung von Feldern in Word (hier Inhaltsverzeichnis).
Da das Makro ohne Unterbrechnung mit der nächsten Datei weitermacht sollten im Makro ggf. die Wartezeiten angepasst werden.
Die Reihenfolge der Dateien kann man nicht beeinflussen. Hier müsste falls zwingend gewünscht eine entsprechende Sortierung der Dateinamen extra eingebaut werden.
Gruß
Franz
'Code in einem allgemeinen Modul im VBA-Editor
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nshowcmd As Long) As Long
Sub File_Print(strFile$)
Call ShellExecute(0, "print", strFile, "", "", 1&)
End Sub
Sub PrintDateieninHyperlinkOrdnern()
'Alle Hyperlinks in Spalte B des aktiven Blatts abarbeiten
Dim objHypLink As Hyperlink, rngZelle As Range
Dim strDir As String
Dim strDatei As String, wkb As Workbook
If MsgBox("Alle Hyperlinks in Spalte B abarbeiten und Dateien " _
& "in den zugehörigen Ordnern drucken?" & vbLf _
& "(ggf. vor dem Start des Makros in der Windows-Systemsteuerung " _
& "den Standarddrucker wechslen!)", _
vbQuestion + vbOKCancel, _
"Dateien in Ordnern drucken") = vbCancel Then Exit Sub
With ActiveSheet
'Zellen in Spalte B abarbeiten
For Each rngZelle In .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Cells
If rngZelle.Hyperlinks.Count > 0 Then
'Ordner-Pfad in Hyperlink-Adresse
strDir = rngZelle.Hyperlinks(1).Address
strDatei = Dir(strDir & "\*.*")
Do Until strDatei = ""
If InStr(1, Right(strDatei, 4), "xls") > 0 Then
'Exceldateien in der aktiven Excelanwendung öffnen und drucken
Set wkb = Application.Workbooks.Open(Filename:=strDir & "\" & strDatei, ReadOnly:= _
True)
wkb.PrintOut
wkb.Close savechanges:=False
Else
'andere Dateien
Call File_Print(strDir & "\" & strDatei)
End If
'Wartezeit 5 Sekunden nach jedem Dokument
Application.Wait Now + TimeSerial(Hour:=0, Minute:=0, Second:=5)
strDatei = Dir
Loop
'Wartezeit 10 Sekunden nach jedem Ordner
Application.Wait Now + TimeSerial(Hour:=0, Minute:=0, Second:=10)
End If
Next
End With
End Sub