FileSearch ohne www

Sub finde_file() DEL Dim i As Long With Application.FileSearch .NewSearch .LookIn = Worksheets("Dateien").Range("G10") .SearchSubFolders = Worksheets("Dateien").Range("K12") .MatchTextExactly = True .Filename = Worksheets("Dateien").Range("K21") .FileType = msoFileTypeAllFiles .Execute For i = 1 To .FoundFiles.Count Cells(i + 29, 2) = .FoundFiles(i) ' muss 29 sein (i=1 ... i+29=30) If i = 999 - 29 Then GoTo step99 Next step99: End With sortieren01 End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Giuseppe,
weil das keine Dateien sondern Links sind. Aber so geht's:

Private Function FavoritenAuslesen()
    Dim T00 As Worksheet, intZeile As Integer, strOrdner As String
    Dim myFileSystemObject As Object, myFolders As Object, myFolder As Object, myFiles As Object, myFile As Object
    Set T00 = Worksheets(1)
    T00.Range("B3").Select
    intZeile = 3
    strOrdner = "C:\Dokumente und Einstellungen\Administrator\Favoriten\"
    Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set myFolder = myFileSystemObject.GetFolder(strOrdner)
    Set myFiles = myFolder.Files
    For Each myFile In myFiles
        If Right(myFile.Name, 4) = ".url" Then
            intZeile = intZeile + 1
            With Application.FileSearch
                .LookIn = strOrdner
                .Filename = Left(myFile.Name, Len(myFile.Name) - 4)
                .FileType = msoFileTypeAllFiles
                .Execute
                ActiveSheet.Cells(intZeile, 2) = .FoundFiles(1)
            End With
            ActiveSheet.Cells(intZeile, 3) = Left(myFile.Name, Len(myFile.Name) - 4)
        End If
    Next
    Set myFolders = myFileSystemObject.GetFolder(strOrdner)
    For Each myFolder In myFolder.SubFolders
        Set myFiles = myFolder.Files
        For Each myFile In myFiles
            If Right(myFile.Name, 4) = ".url" Then
                intZeile = intZeile + 1
                With Application.FileSearch
                    .LookIn = strOrdner & myFolder.Name
                    .FileType = msoFileTypeAllFiles
                    .Filename = Left(myFile.Name, Len(myFile.Name) - 4)
                    .Execute
                    ActiveSheet.Cells(intZeile, 2) = .FoundFiles(1)
                End With
                ActiveSheet.Cells(intZeile, 3) = Left(myFile.Name, Len(myFile.Name) - 4)
            End If
        Next
    Next
    Set myFileSystemObject = Nothing
    Set myFolders = Nothing
    Set myFolder = Nothing
    Set myFiles = Nothing
    Set myFile = Nothing
    Set T00 = Nothing
End Function

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread