Word - Nur 1.Seite von mehreren Docs drucken?

Option Explicit
'© 2003 Matthias Köhler, [email][email protected][/email]


' Typdeklaration für API-Dialog->Verzeichnis auswählen'
    Private Type BrowseInfo
        hOwner          As Long
        pidlRoot        As Long
        pszDisplayName  As String
        lpszTitle       As String
        ulFlags         As Long
        lpfn            As Long
        lParam          As Long
        iImage          As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib shell32.dll (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHBrowseForFolder Lib shell32.dll (lpBrowseInfo As BrowseInfo) As Long

' Ermittelt Verzeichnisnamen und zeigt Windows-Dialog an
Public Function VerzeichnisWählen(Optional DialogTitel) As String
    Dim StrukturVerzeichnisInfo As BrowseInfo, ListenNr As Long, Pfad As String
    Dim hWndAccessApp As Long
  
    With StrukturVerzeichnisInfo
        .hOwner = hWndAccessApp
        .lpszTitle = IIf(IsMissing(DialogTitel), Verzeichnispfad auswählen, CStr(DialogTitel))
        .ulFlags = &H1-> BIF_RETURNONLYFSDIRS
    End With
    
    ListenNr = SHBrowseForFolder(StrukturVerzeichnisInfo)
    Pfad = Space$(512)
    
    If SHGetPathFromIDList(ByVal ListenNr, ByVal Pfad) Then VerzeichnisWählen = Left(Pfad, InStr(Pfad, vbNullChar) - 1)
    
End Function



Public Sub DokumenteAusVerzeichnis_1Seite_Drucken()
'Makro zum Ausdrucken der ersten Seite aller *.doc-Files eines Directories
'mit Auswahl des Pfades
'(die Ausgabe des eigenen Dokumentes wird unterdrückt)

Dim fs As FileSearch
Dim i As Long
Dim sSuchpfad As String
Dim ret As Integer

 -> Auswahl des Pfades
  sSuchpfad = VerzeichnisWählen(Bitte wählen Sie das Verzeichnis)

  If sSuchpfad =  Then
    ret = MsgBox(Es wurde kein Suchpfad eingegeben ! & vbCrLf & Der Makro wird beendet., _
            vbOKOnly + vbInformation, Kein Suchpfad ausgewählt)
  Else

   ->Filenamen aus dem Directory sPath auflisten
    Set fs = Application.FileSearch
     
    fs.NewSearch
    fs.LookIn = sSuchpfad
    fs.FileName = *.doc
    i = fs.Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending)
    If fs.FoundFiles.Count > 0 Then
      For i = 1 To fs.FoundFiles.Count
       ->nicht das eigene Dokument
        If fs.FoundFiles(i) <> (ThisDocument.FullName) Then
          Application.PrintOut FileName:=fs.FoundFiles(i), _
                            Range:=wdPrintFromTo, From:=1, To:=1
          DoEvents
        End If
      Next i
    Else
      MsgBox Keine Dokumente gefunden
    End If
  End If
End Sub