Funktion för filsökning
FSOHär demonstreras en funktion för att söka efter filer. Är det endast en fil som ska eftersökas är filsökning mha Application.FileSearch att rekommendera - Filsökning.
Glöm inte av att ange referens till Microsoft Scripting Runtime - Läs mer här»
Option Explicit
Option Base 0
Sub Soka_Filer()
'© 2002 Alla rättigheter XL-Dennis
Dim Filer() As String, stMapp As String, stFiler As String
Dim i As Long
ReDim Filer(1 To 1)
stMapp = "e:\Arbetsmaterial"
'Excel-filer vars namn är en del av Dennis
stFiler = "*ennis*.xls"
If SokFiler(stMapp, stFiler, Filer, True) Then
For i = 1 To UBound(Filer)
Cells(1 + i, 1).Value = Filer(i)
Next i
End If
End Sub
Function SokFiler(stMapp As String, stFil As String, stFilArray() As String, _
blUMappar As Boolean) As Boolean
'© 2002 Alla rättigheter XL-Dennis
Dim fsoObj As scripting.FileSystemObject
Dim fsoMapp As scripting.Folder
Dim fsoSubMapp As scripting.Folder
Dim stFilNamn As String
Set fsoObj = New scripting.FileSystemObject
If fsoObj.FolderExists(stMapp) Then
Set fsoMapp = fsoObj.GetFolder(stMapp)
Else
MsgBox "Sökvägen kan inte hittas."
SokFiler = False
Exit Function
End If
'Här hittas första filen som matchar sökväg och filvillkoret.
'Se direkthjälpen om Dir-funktionen.
stFilNamn = Dir(fsoObj.BuildPath(stMapp, stFil))
'För att hitta nästa eventuella matchande filer initieras en loop som
'a) utvärderar om det finns fler filer och
'b) lägger till dessa i arrayen.
Do While stFilNamn <> ""
stFilNamn = fsoObj.BuildPath(stMapp, stFilNamn)
stFilNamn = Dir()
If stFilArray(1) = "" Then
stFilArray(1) = stFilNamn
Else
ReDim Preserve stFilArray(1 To UBound(stFilArray) + 1)
stFilArray(UBound(stFilArray)) = stFilNamn
End If
Loop
'Om sökning även ska ske i undermappar.
If blUMappar Then
For Each fsoSubMapp In fsoMapp.SubFolders
SokFiler fsoSubMapp.Path, stFil, stFilArray, True
Next
End If
SokFiler = True
Set fsoSubMapp = Nothing
Set fsoMapp = Nothing
Set fsoObj = Nothing
End Function