Von einem Excell Anfänger Frage:

[Darth-Sam]

Hallo zusammen, muss mich nun gerade mit einem Excel Problem herumschlagen bzw. für den Profi ist es vielleicht keines.
In einem Ordner auf dem Laufwerk D befinden sich diverse Excel und Word Dokumente. Diese können auch in Unterordnern sich befinden. Ziel ist diese Dokumente in Excel anzeigen zu lassen als eine Liste. Und wenn ich den Eintrag anklicke soll das Dokument - ob Excel oder Word entsprechend geöffnet werden. Geht das überhaupt? Oder Makro?  Ich möchte die Dokumente nicht mit der Hand erfassen.
Hoffe mein Problem ist erkannt worden. Vielleicht hat jemand eine Lösung für mich.
Vielen Dank für Eure Hilfe schon mal im Voraus

[RPP63]

Moin!
Nun ja, leichte Kost ist das ja nicht.
Ich habe allerdings in meinem Fundus eine Datei (im Anhang), die ein neues Tabellenblatt mit Hyperlinks von Dateien eines beliebigen Ordners (wahlweise incl. Unterordner) erstellt.
Wer die Datei wegen der vorhandenen Makros nicht herunterladen mag, sieht wie folgt den kompletten Code in einem allgemeinen Modul:

Modul Modul1

Option Explicit 

  

Public x() 

Public i# 

Public objShell, objFolder, objFolderItem 

Public FSO, oFolder, oFile 



Sub MainExtractData() 

   Dim NewSht As Worksheet 

   Dim MainFolderName$, k# 

   Dim SubFolders As Boolean 

   Redim x(1 To 2 ^ 20, 1 To 3) 

   Set objShell = CreateObject("Shell.Application") 

   Application.ScreenUpdating = False 

PfadName: 

   MainFolderName = BrowseForFolder() 

   If MainFolderName = "" Then _

      If MsgBox("Willst Du wirklich abbrechen?", vbYesNo + vbQuestion) = vbNo Then _

         GoTo PfadName Else Exit Sub 

   SubFolders = MsgBox("Unterordner einbeziehen?", vbYesNo + vbQuestion) = vbYes 

   ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count) 

   x(1, 1) = "FullName" 

   x(1, 2) = "FileName" 

   x(1, 3) = "Hyperlink" 

   i = 1 

   Set FSO = CreateObject("scripting.FileSystemObject") 

   Set oFolder = FSO.GetFolder(MainFolderName) 

   For Each oFile In oFolder.Files 

      Set objFolder = objShell.Namespace(oFolder.Path) 

      Set objFolderItem = objFolder.ParseName(oFile.Name) 

      i = i + 1 

      If i > 66530 Then   'maximale Anzahl an Hyperlinks pro Blatt! 

        MsgBox "Abbruch! max. Anzahl Hyperlinks in " & ActiveSheet.Name & " erreicht!" 

        GoTo Formatieren 

      End If 

      Application.StatusBar = "Datei " & i - 1 & " wird bearbeitet …" 

      DoEvents 

      x(i, 1) = oFolder.Path & "\" & oFile.Name 

      x(i, 2) = oFile.Name 

   Next 

   If SubFolders Then Call RecursiveFolder(oFolder) 

Formatieren: 

   Range("A1:C" & i) = x 

   For k = 2 To i 

      ActiveSheet.Hyperlinks.Add _

         Anchor:=Cells(k, 3), _

         Address:=Cells(k, 1).Text, _

         ScreenTip:="Link zu: " & Cells(k, 1).Text, _

         TextToDisplay:=Cells(k, 2).Text 

   Next 

   Range("A:C").EntireColumn.AutoFit 

   Columns(2).Hidden = True 

   Range("1:1").Font.Bold = True 

   Rows("2:2").Select 

   ActiveWindow.FreezePanes = True 

   Application.GoTo Range("A1") 

   Set FSO = Nothing 

   Set objShell = Nothing 

   Set oFolder = Nothing 

   Set objFolder = Nothing 

   Set objFolderItem = Nothing 

   Set oFile = Nothing 

   Application.StatusBar = "" 

   Application.ScreenUpdating = True 

End Sub 



Sub RecursiveFolder(xFolder) 

   Dim SubFld 

   For Each SubFld In xFolder.SubFolders 

      Set oFolder = FSO.GetFolder(SubFld) 

      Set objFolder = objShell.Namespace(SubFld.Path) 

      For Each oFile In SubFld.Files 

         Set objFolder = objShell.Namespace(oFolder.Path) 

         If Not objFolder Is Nothing Then 

            Set objFolderItem = objFolder.ParseName(oFile.Name) 

            i = i + 1 

               Application.StatusBar = "Datei " & i - 1 & " wird bearbeitet …" 

               DoEvents 

            x(i, 1) = SubFld.Path & "\" & oFile.Name 

            x(i, 2) = oFile.Name 

         End If 

      Next 

      Call RecursiveFolder(SubFld) 

   Next 

End Sub 



Function BrowseForFolder(Optional OpenAt As Variant) As Variant 

   Dim ShellApp As Object 

   Set ShellApp = CreateObject("Shell.Application"). _

      BrowseForFolder(0, "Ordner wählen", 0, OpenAt) 

   On Error Resume Next 

   BrowseForFolder = ShellApp.self.Path 

   On Error GoTo 0 

   Set ShellApp = Nothing 

End Function 

Gruß Ralf

[Darth-Sam]

Ralf DANKE !  habe es hinbekommen. Der Tag ist gerettet. :23: :23: :23:

[RPP63]

Dann gehe ich davon aus, dass Deine PN an mich gegenstandslos ist.
Im Übrigen wäre eine Erklärung des Makros ein mittleres Buch.

Gruß Ralf

[Darth-Sam]

wegen dem Buch, hast du eine empfehlung?

[RPP63]

Sorry, nicht ganz ernst gemeint, aber auf Grund Deiner Frage ist folgendes Buch ein Muss:
Lesenswert!

"Mein" Code, der auch nur eine Quintessenz aus Fundstellen ist, bewegt sich in der Windows-Welt und hat nicht viel mit Excel-VBA zu tun.
Daher liefert Tante G. bereits hervorragende Grundlagen.

Gruß Ralf

[Käpt'n Blaubär]

Hallo Ralf,

Sorry, nicht ganz ernst gemeint, aber auf Grund Deiner Frage ist folgendes Buch ein Muss:
Lesenswert!

finde ich außerordentlich treffsicher eingesetzt :18: