Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verzeichnisstruktur aus Explorer in Excel verlinkn

Verzeichnisstruktur aus Explorer in Excel verlinkn
Felix
Hallo zusammen,
das könnte die Frage nach einer eierlegenden Wollmilchsau sein, ich probiere es trotzdem:
Ich habe auf einem Laufwerk eine Verzeichnisstruktur mit Ordnern von 1 bis 10 und Unterordnern angelegt. Diese Verzeichnisstruktur möchte ich mittels VBA in Excel übertragen (eine Art Inhaltsverzeichnis erstellen) und die Dateien darin verlinken.
Ist sowas grunsätzlich möglich?
AW: Verzeichnisstruktur aus Explorer in Excel verlinkn
21.06.2010 15:35:23
Rudi
Hallo,
sicher geht das.
In ein Modul
Option Explicit
Dim vntFiles(), lngFiles As Long
Sub prcFolders()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
Set wksInhalt = ThisWorkbook.Sheets("Inhalt")
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolder = "c:\test"  'anpassen
GetMoreSpeed
Set oFolder = FSO.getfolder(strFolder)
lngFiles = 1
With ActiveSheet
.Range("A:C").ClearContents
.Cells(1, 1) = "Pfad"
.Cells(1, 2) = "Dateiname"
.Range(.Cells(1, 1), .Cells(1, 3)).Font.Bold = True
End With
prcFiles oFolder
prcSubFolders oFolder
With ActiveSheet
.Range(.Cells(2, 1), .Cells(lngFiles, 2)) = WorksheetFunction.Transpose(vntFiles)
.Activate
End With
GetMoreSpeed 0
Application.ScreenUpdating = True
End Sub

Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.subfolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub

Sub prcFiles(oFolder)
Dim oFile As Object
For Each oFile In oFolder.Files
ReDim Preserve vntFiles(1 To 2, 1 To lngFiles)
vntFiles(1, lngFiles) = oFolder.Path
vntFiles(2, lngFiles) = "=hyperlink(""" & oFile.Path & """;""" & oFile.Name & """)"
lngFiles = lngFiles + 1
Next
End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc  0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub

Anzeige
Was bedeutet dies:
21.06.2010 16:20:51
Holger
Hallo Rudi,
ich lese oft mit Interesse deine Postings, habe eine Frage zu dem Sub, welches unten steht.
Was hat es mit .Calculation auf sich?
Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc  0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub

Anzeige
AW: Verzeichnisstruktur aus Explorer in Excel verlinkn
21.06.2010 16:01:54
Tino
Hallo,
hier noch eine Variante.
https://www.herber.de/bbs/user/70193.xls
Gruß Tino
Anzeige
AW: hab noch eine bei mir gefunden...
21.06.2010 18:34:07
Felix
danke Rudi, Nonet und Tino,
Add ins kann ich leider auf dem Firmenrechner nicht installieren, weswegen ich Nonets Lösung nicht probieren können
Rudis und Tinos Lösungen klappen super!!
DOCH EIN KLEINER FEHLER
22.06.2010 11:43:23
Felix
Hallo Tino,
doch noch eine kleine Frage zu deinem Tool.
Wenn ich die Verzeichnisse lokal abliegen habe funktioniert alles super. Wenn ich allerdings den gleichen Verzeichnisbaum auf ein Netzwerklaufwerk kopiere (unter sehr vielen Unterorndern), dann kommt folgender Fehler:
"Automatisierungsfehler: Das aufgerufene Objekt wurde von den Clients getrennt. "
Die fett markierte Zeile wirft einen Fehler auf.
Eine Idee woran das liegen könnte? Das Netzwerk ist in jedem Fall stabil und schnell (Firmennetz)
'Ordnername + Formatierung + Dateien schreiben *******************************************************
ErsatzPath = Replace(strFolders(LCount) & "\", strPathTemp & "\", "")
ErsatzPath = ".." & Right$(ErsatzPath, Len(ErsatzPath) - InStr(ErsatzPath, "\") + 1)
rngErste.Offset(1, 1) = ErsatzPath
rngErste.Offset(1, 1).Font.Bold = True: rngErste.Offset(1, 1).Font.ColorIndex = 16
rngErste.Offset(2, 1).Resize(UBound(varListe) + 1).Formula = Application.Transpose(varListe)
Set rngLetzte = .Cells(.Cells.Find("*", , xlValues, 1, 1, xlPrevious, False, False, False).Row, 1)
Anzeige
kann ich nicht prüfen...
22.06.2010 14:06:57
Tino
Hallo,
ohne die entsprechende Umgebung.
lt. MS gibt es mehrere Uhrsachen für die Meldung
Automatisierungsfehler: Das aufgerufene Objekt wurde von den Clients getrennt.
sorry
Gruß Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige