title image


Smiley Ganz einfach ->
Hallo !



Du brauchst im Prinzip nur das CD Laufwerk nach allen Ordnern durchlaufen lassen, und ganz am Anfang ein On Error machen. Tritt ein Fehler auf so ist keine CD im Laufwerk.



Dazu musst du die "Microsoft Scripting Runtime" unter PROJEKT -> VERWEISE einbinden.



Nun brauchst du noch folgenden Code:





'Button bei der die Suche gestartet wird



Private Sub cmdSearchFile_Click()



Dim oFSO As New Scripting.FileSystemObject

Dim oFolder As Scripting.Folder

Dim sExtension As String



'Pfad zum CD Rom Laufwerk



Set oFolder = oFSO.GetFolder("D:\")



'Eyxtension nach der gesucht werden soll



sExtension="exe"



SearchFolder oFolder, sExtension



lblStatus.Caption = ""



End Sub







'Rekursive Funktion zum Durchsuchen aller Unterordner



Public Sub SearchFolder(oFolder As Folder, sExtension)



Dim oSubFolder As Folder

Dim oFile As File



On Error Resume Next



For Each oSubFolder In oFolder.SubFolders

SearchFolder oSubFolder, sExtension

Next



For Each oFile In oFolder.Files



If And InStr(1, GetExt(oFile.Name), sExtension) Then

txtResult.text = txtResult.text & oFile.Path & "\" & oFile.Name & vbcrlf

End If

Next



End Sub







'Funktion die die Extension einer Datei zurückgibt



Private Function GetExt(sFile As String)As String



GetExt = Right(sFile, (Len(sFile)) - InStrRev(sFile, "."))



End Function







Ich hoffe ich habe nicht zu viele Fehler reingemacht, aber ich denke mal du verstehst wies gemeint ist.



Ciao und Grüße aus Österreich,



Marcel

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: