VBA-Beispiel 065
mail schreiben
mail schreiben

alle Exceldateien eines Verzeichnisses ausdrucken
Es werden alle Exceldateien eines Ordners (ohne Unterordner) mit allen Tabellen ausgedruckt.
Sub alle_Dateien_drucken()
'alle Dateien eines Verzeichnisses mit allen Tabellen drucken
Dim Pfad As String
Dim fs As Object
Dim Datei As Long
Dim wks As Worksheet

On Error GoTo Hell

If Val(Application.Version) > 11 Then
  MsgBox "Dieses Makro funktioniert nur bis einschl. Excel 11.0" _
    & vbNewLine & _
    "Sie haben aber Excel: " & Application.Version _
    & vbNewLine & vbNewLine _
    & "keine Änderungen durchgeführt", , "Abbruch"
  Exit Sub
End If

'Pfad anpassen
Pfad = "C:\Eigene Dateien\"
'Pfad = ThisWorkbook.Path & "\"

'prüfen ob Pfad existiert
If Dir(Pfad) = "" Then
  MsgBox "Pfad existiert nicht", , "Abbruch"
  Exit Sub
End If

Set fs = Application.FileSearch

With fs
    .LookIn = Pfad
    .Filename = "*.xls"
   'ohne Unterordner
    .SearchSubFolders = False

    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then

        For Datei = 1 To .FoundFiles.Count
         'Datei öffnen
          Workbooks.Open Pfad & Dir(.FoundFiles(Datei))
             'jede Tabelle ausdrucken
              For Each wks In ActiveWorkbook.Worksheets
                  wks.PrintOut Copies:=1
              Next wks
         'Datei schließen
          ActiveWorkbook.Close
        Next Datei

    Else
        MsgBox "Keine Dateien gefunden"
        Exit Sub
    End If
End With

Set fs = Nothing

Exit Sub

Hell:
MsgBox "Fehlernummer: " & Err.Number & vbNewLine _
      & "Fehlermeldung: " & Err.Description, , ""

Err.Clear

Resume Next

End Sub
Download:   vba065.zip
relevante Links:

top