DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Dateiname_Hyperlink()
Dim StDateiname As String
Dim Dateiform As String
Dim InI As Long, TotFiles As Long
Dim Suchpfad As String
Dim OldStatus As Variant
Suchpfad = InputBox("Yolunu değiştirebilirsiniz", "Adres yolu", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Dosya uzantısını siz değiştiriniz", "Uzantı", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
Sheets.Add After:=Worksheets(Worksheets.Count)
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For InI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei: " & InI & " von " & TotFiles
StDateiname = Mid(.FoundFiles(InI), InStrRev(.FoundFiles(InI), "\") + 1)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(InI, 1), _
Address:=.FoundFiles(InI), TextToDisplay:=StDateiname
Cells(InI, 2) = FileLen(.FoundFiles(InI))
Cells(InI, 3) = FileDateTime(.FoundFiles(InI))
Next InI
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub