'-Begin-----------------------------------------------------------------
'-
'- Ermittlung aller Titel aller PDF-Dateien in einem Verzeichnis-
'- baum
'-
'-----------------------------------------------------------------------

  Option Explicit

  '-Constants-----------------------------------------------------------
    Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
    Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
    Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
    Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
    Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
    Const FILE_ATTRIBUTE_READONLY As Long = &H1&
    Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
    Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&
    
    Const MAX_PATH = 260

  '-Structures----------------------------------------------------------
    Private Type FILETIME
      dwLowDateTime As Long
      dwHighDateTime As Long
    End Type

    Private Type WIN32_FIND_DATA
      dwFileAttributes As Long
      ftCreationTime As FILETIME
      ftLastAccessTime As FILETIME
      ftLastWriteTime As FILETIME
      nFileSizeHigh As Long
      nFileSizeLow As Long
      dwReserved0 As Long
      dwReserved1 As Long
      cFileName As String * MAX_PATH
      cAlternate As String * 14
    End Type
  
  '-External Functions--------------------------------------------------
    Private Declare Function FindFirstFile Lib "kernel32" Alias _
      "FindFirstFileA" (ByVal lpFileName As String, _
      lpFindFileData As WIN32_FIND_DATA) As Long

    Private Declare Function FindNextFile Lib "kernel32" Alias _
      "FindNextFileA" (ByVal hFindFile As Long, _
      lpFindFileData As WIN32_FIND_DATA) As Long

    Private Declare Function FindClose Lib "kernel32" (ByVal _
      hFindFile As Long) As Long

  '-GlobalVariables-----------------------------------------------------
    Private glFolderPath As String
  
  '-FindPDFFile---------------------------------------------------------
  '-
  '- Findet alle PDF-Dateien in einer Verzeichnisstruktur, schreibt
  '- deren Titel in das aktive Word-Dokument und setzt einen Link
  '- auf die PDF-Datei
  '-
  '---------------------------------------------------------------------
    Sub FindPDFFile(ByVal FolderPath As String, _
      ByVal Relative As Boolean)

      '-Local Variables-------------------------------------------------
        Dim WFD As WIN32_FIND_DATA
        Dim hSearch As Long
        Dim strFileName As String
        Dim relPath As String
        Dim aDoc As Acrobat.AcroPDDoc

      If Right$(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
      End If
      
      hSearch = FindFirstFile(FolderPath & "*.*", WFD)
      If hSearch <> INVALID_HANDLE_VALUE Then
        Do
          strFileName = Left(WFD.cFileName, InStr(WFD.cFileName, _
            Chr(0)) - 1)
          If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
            = FILE_ATTRIBUTE_DIRECTORY Then
            If (strFileName <> ".") And (strFileName <> "..") Then
              '-Rekursiver Funktionsaufruf, wenn neuer Ordner-----------
                FindPDFFile FolderPath & strFileName, Relative
            End If
          Else
            If LCase(Right(strFileName, 3)) = "pdf" Then
              '-PDF-Dokument oeffnen------------------------------------
                Set aDoc = CreateObject("AcroExch.PDDoc")
                aDoc.Open FolderPath & strFileName
              '-Titel des PDF-Dokumentes in Word schreiben--------------
                Selection.TypeText aDoc.GetInfo("Title")
              '-Verlinkung zum PDF-Dokument herstellen------------------
                Selection.HomeKey
                Selection.EndKey wdLine, wdExtend
                If Relative Then
                  '-Relativer Pfad--------------------------------------
                    relPath = Right(FolderPath, Len(FolderPath) - _
                      Len(glFolderPath))
                    Hyperlinks.Add Selection.Range, relPath & _
                      strFileName
                Else
                  '-Absoluter Pfad--------------------------------------
                    Hyperlinks.Add Selection.Range, FolderPath & _
                      strFileName
                End If
                Selection.TypeParagraph
              '-PDF-Dokument schliessen---------------------------------
                aDoc.Close
                Set aDoc = Nothing
            End If
          End If
        Loop While FindNextFile(hSearch, WFD)
        FindClose hSearch
      End If
    
    End Sub

  '-RelativeStub--------------------------------------------------------
  '-
  '- Vorgelagerte Prozedur von FindPDFFile zur Beruecksichtigung
  '- relativer Pfade
  '-
  '---------------------------------------------------------------------
    Sub RelativeStub(ByVal FolderPath As String, _
      ByVal Relative As Boolean)
      
      '-Set global variable---------------------------------------------
        glFolderPath = FolderPath
      
      '-Save document in folder-----------------------------------------
        ActiveDocument.SaveAs FolderPath & "Index.doc"
      
      FindPDFFile FolderPath, Relative
      
      '-Save and close document-----------------------------------------
        ActiveDocument.Close wdSaveChanges
    
    End Sub
  
  '-GetAllPDFFilesTitles------------------------------------------------
    Sub GetAllPDFFilesTitles()
      
      '-Local Variables-------------------------------------------------
        '-Here flag for using reltive path------------------------------
          Dim Relative As Boolean
          Relative = True
        '-Here path to the root of the PDF files------------------------
          Dim FolderPath As String
          FolderPath = "D:\Dummy"
      
      If Right$(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
      End If
      
      RelativeStub FolderPath, Relative
      
    End Sub

'-End-------------------------------------------------------------------