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
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 Modul1Option 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
Ralf DANKE ! habe es hinbekommen. Der Tag ist gerettet. :23: :23: :23:
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
wegen dem Buch, hast du eine empfehlung?
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
Hallo Ralf,
Zitat:Sorry, nicht ganz ernst gemeint, aber auf Grund Deiner Frage ist folgendes Buch ein Muss:
Lesenswert!
finde ich außerordentlich treffsicher eingesetzt :18: