Find stinavn ud fra filnavn

Inspiration: http://www.eksperten.dk/spm/916623

hej Supertekst - har prøvet at få noget fornuftigt ud af det men det kan jeg ikke finde ud af.

Jeg har løst det midlertidigt ved at lave en oversigt over billedfiler der hvor jeg vil finde billedet og så lave en vlookup - men det tager en del tid at opdatere og så er det videre smart..

Har du mulighed for at hjælpe med at gøre kode lidt mere konkret ?

Min nuværende kode ser således ud.

Sub Listfiles()
   
    Range("B11").Select
    Selection.CurrentRegion.Select
    Selection.ClearContents
   
    iRow = 11
    Call ListMyFiles(Range("B6"), Range("B7"))
End Sub



Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    If InStr(MyFile.Path, ".txt") <> 0 Then
        For Each MyFile In mySource.Files
     
            iCol = 1
            Cells(iRow, iCol).Value = MyFile.Name
            iCol = iCol + 1
            Cells(iRow, iCol).Value = MyFile.Path
            iCol = iCol + 1
            'Cells(iRow, iCol).Value = MyFile.Name
            'iCol = iCol + 1
            Cells(iRow, iCol).Value = MyFile.Size
            iCol = iCol + 1
            Cells(iRow, iCol).Value = MyFile.DateLastModified
            iRow = iRow + 1
        Next
    End If
    'Columns("C:E").AutoFit
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub




Pft.

Jens

Hej Jens

Jeg skal forsøge, men du må gerne præcisere formålet:

Som jeg forstår det:
Du har 10 filnavne. Du søger i én mappe og dennes undermapper efter det enkelte filnavn og returnerer filstien i kolonne B.

Ok?

Hej Supertekst !

Ja, det er korrekt forstået.

mvh

Jens

Const drevSTi = "C:\Users\peter\Desktop\EkspFindFilSti\Hovedmappe\"            'JUSTERES
Dim antalRækker As Long, mapNavn As String, filNavn As String

Dim ræk As Integer, søgFil As String
Public Sub findFilStiSystem()
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
    mapNavn = ""
    filNavn = ""
   
    For ræk = 1 To ActiveCell.SpecialCells(xlLastCell).Row
        søgFil = Range("A" & ræk)
        traverserDrev drevSTi
    Next ræk
   
End Sub
Private Sub traverserDrev(mappenavn)
    Dim fs, f, f1, fc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappenavn)
    Set fc = f.SubFolders
   
    For Each f1 In fc
        mapNavn = mapNavn & f1.Name & vbCrLf
       
        findFiler f1.Path, f1.Name
       
        traverserDrev f1
    Next
End Sub
Private Sub findFiler(mappesti, mappe)
Dim fs, f, f1, fc, fNavn As String, ext As String, navnSplit As Variant

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappesti)
    Set fc = f.Files
   
    For Each f1 In fc
        filNavn = filNavn & mappe & "\" & f1.Name & vbCrLf
       
        navnSplit = Split(f1.Name, ".")
        fNavn = navnSplit(0)
        ext = "." & navnSplit(1)
       
        If fNavn = søgFil Then
            Range("B" & ræk) = mappesti & "\" & søgFil
            Exit Sub
        End If
    Next
End Sub

Hvis du har brug for at se min model - så send en mail.
@-adresse under min profil.

Nogen afklaring?

Har lagt svar 24/2 !