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