http://www.eksperten.dk/spm/267499 (sion)

http://www.eksperten.dk/spm/267499

Du vælger at søge efter musikfiler alene,
og så søger du på:

LOVE*

efterfulgt af en stjerne -

Så finder du alle musikfiler hvor titlen indeholder tegnene LOVE -

Håber det var svar nok!

zliber: han skal nu søge på: *Love*, ellers søger den kun på det der starter på love.

Det gizmo spørger til er hvordan man gør det med koden fra http://www.eksperten.dk/spm/267499, ikke hvordan man gør det i stifinder. Nå, men du kan f.eks. bruge nedenstående kode:
   
    Dim FindTekst As String, SoegITekst as string
    FindTekst = "love"
    SoegITekst = MP3array(UBound(MP3array))

    'Undersøger om den ønskede tekst indgår i den fundne tekst
    If InStr(1, Ucase(SoegITekst),Ucase(FindTekst), vbTextCompare) <> 0 Then
        'Match fundet! Tilføjer teksten til listbox'en
        listNummer.AddItem SoegITekst
    End If

-Sion

Hovsa - da jeg bruger vbTextCompare-metoden kan du godt undlade Ucase-funktionerne i InStr... :)

sion:> hvor sætter jeg dit eksempel ind?

her er din lidt omskrevne kode:

Private Sub Command1_Click()
      MP3s = GetAllFiles(Text1.Text, "*.mp3", True).Count
End Sub
Private Sub Dir1_Change()
   
    Text1.Text = Text1.Text + Mid(Dir1.Path, 4, Len(Dir1.Path))
End Sub
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
    Text1.Text = Left(Dir1.Path, 3)
End Sub
Function GetAllFiles(ByVal Path As String, ByVal filespec As String, Optional RecurseDirs As Boolean) As Collection
    Dim spec As Variant
    Dim file As Variant
    Dim subdir As Variant
    Dim subdirs As New Collection
    Dim specs() As String
   
    ' initialize the result
    Set GetAllFiles = New Collection
   
    ' ensure that path has a trailing backslash
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
   
    ' get the list of provided file specifications
    specs() = Split(filespec, ";")
   
    ' this is necessary to ignore duplicates in result
    ' caused by overlapping file specifications
    On Error Resume Next
               
    ' at each iteration search for a different filespec
    For Each spec In specs
        ' start the search
        file = Dir$(Path & spec)
        Do While Len(file)
            ' we've found a new file
            If HeleStien = True Then
                file = Path & file
            Else
                file = file
            End If
            GetAllFiles.Add file, file
            listNummer.AddItem GetAllFiles.Item(file) 'LavDirTræ Path, GetAllFiles.Item(file), True
            'OpstilMp3er (Path & file)
            ' get ready for the next iteration
            file = Dir$
        Loop
    Next
   
    ' first, build the list of subdirectories to be searched
    If RecurseDirs Then
        ' get the collection of subdirectories
        ' start the search
        file = Dir$(Path & "*.*", vbDirectory)
        Do While Len(file)
            ' we've found a new directory
            If file = "." Or file = ".." Then
                ' exclude the "." and ".." entries
            ElseIf (GetAttr(Path & file) And vbDirectory) = 0 Then
                ' ignore regular files
            Else
                ' this is a directory, include the path in the collection
                file = Path & file
                subdirs.Add file, file
            End If
            ' get next directory
            file = Dir$
        Loop
        ' parse each subdirectory
        For Each subdir In subdirs
            ' use GetAllFiles recursively
            For Each file In GetAllFiles(subdir, filespec, True)
                GetAllFiles.Add file, file
               
            Next
        Next
    End If
   
End Function

Du skal først have en ny sub med i koden, nemlig:

Private Sub OpstilMp3er(Filsti As String)
    Dim MP3array() As String
    MP3array() = Split(Filsti, "\")
    'listKunstner.AddItem MP3array(UBound(MP3array) - 2)
    'listAlbum.AddItem MP3array(UBound(MP3array) - 1)
    listNummer.AddItem MP3array(UBound(MP3array))
End Sub

Derefter kan du indsætte "OpstilMp3er (Path & file)" i stedet for linjen "List1.AddItem GetAllFiles.Item(file)" (cirka midt i koden)

Du kan evt. inkludere FindTekst-variablen i parameteren til GetAllFiles-funktionen.

-Sion

Humm! jeg er ikke helt med, med de nye rettelser, sker det samme som før, alle *.mp3 bliver vist i listboxen (listNummer).

Er det min kode der er galt?

'kode
Private Sub Command1_Click()
    'MP3s = GetAllFiles("F:\musik", "*.mp3", True).Count
    MP3s = GetAllFiles(Text1.Text, "*.mp3", True).Count
End Sub

Private Sub Dir1_Change()
        Text1.Text = Text1.Text + Mid(Dir1.Path, 4, Len(Dir1.Path))
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
    Text1.Text = Left(Dir1.Path, 3)
End Sub

Function GetAllFiles(ByVal Path As String, ByVal filespec As String, Optional RecurseDirs As Boolean) As Collection
    Dim spec As Variant
    Dim file As Variant
    Dim subdir As Variant
    Dim subdirs As New Collection
    Dim specs() As String
   
    ' initialize the result
    Set GetAllFiles = New Collection
   
    ' ensure that path has a trailing backslash
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
   
    ' get the list of provided file specifications
    specs() = Split(filespec, ";")
   
    ' this is necessary to ignore duplicates in result
    ' caused by overlapping file specifications
    On Error Resume Next
               
    ' at each iteration search for a different filespec
    For Each spec In specs
        ' start the search
        file = Dir$(Path & spec)
        Do While Len(file)
            ' we've found a new file
            If HeleStien = True Then
                file = Path & file
            Else
                file = file
            End If
            GetAllFiles.Add file, file
            'listNummer.AddItem GetAllFiles.Item(file) 'LavDirTræ Path, GetAllFiles.Item(file), True
           
            OpstilMp3er (Path & file)
            ' get ready for the next iteration
            file = Dir$
        Loop
    Next
   
    ' first, build the list of subdirectories to be searched
    If RecurseDirs Then
        ' get the collection of subdirectories
        ' start the search
        file = Dir$(Path & "*.*", vbDirectory)
        Do While Len(file)
            ' we've found a new directory
            If file = "." Or file = ".." Then
                ' exclude the "." and ".." entries
            ElseIf (GetAttr(Path & file) And vbDirectory) = 0 Then
                ' ignore regular files
            Else
                ' this is a directory, include the path in the collection
                file = Path & file
                subdirs.Add file, file
            End If
            ' get next directory
            file = Dir$
        Loop
        ' parse each subdirectory
        For Each subdir In subdirs
            ' use GetAllFiles recursively
            For Each file In GetAllFiles(subdir, filespec, True)
                GetAllFiles.Add file, file
               
            Next
        Next
    End If
   
End Function

Private Sub OpstilMp3er(Filsti As String)
    Dim MP3array() As String
    MP3array() = Split(Filsti, "\")
    'listKunstner.AddItem MP3array(UBound(MP3array) - 2)
    'listAlbum.AddItem MP3array(UBound(MP3array) - 1)
    listNummer.AddItem MP3array(UBound(MP3array))
End Sub

hehe, der blev vist misset noget af koden et eller andet sted... Du skal i hvert fald erstatte din OpstilMp3er-sub med nedenstående kode:

Private Sub OpstilMp3er(Filsti As String)
    Dim MP3array() As String
    MP3array() = Split(Filsti, "\")

    Dim FindTekst As String, SoegITekst As String
    FindTekst = Text1.Text
    SoegITekst = MP3array(UBound(MP3array))

    'Undersøger om den ønskede tekst indgår i den fundne tekst
    If InStr(1, UCase(SoegITekst), UCase(FindTekst), vbTextCompare) <> 0 Then
        'Match fundet! Tilføjer teksten til listbox'en
        listNummer.AddItem SoegITekst
    End If
End Sub

(Text1.text er den tekst som der søges efter)
Det er nok en god idé at tilføje linjen 'listNummer.Clear' et sted i starten af koden, for at der ikke blot bliver fyldt flere linjer ind i listbox'en hvis der søges flere gange :D
Håber at det hele du skulle være på sin plads
-Sion