Filesearch recursive

Mit freundlicher Erlaubnis eines Kollegen.


'global Dims
Dim oFolderDictionary, iMSIIndex, sStartFolder
Set oFolderDictionary = CreateObject("Scripting.Dictionary")

'Configuration
sStartFolder = "M:\2_Paketierung\_Http_Frnk"

'Main Program
createFolderArray sStartFolder
iMSIIndex = getMSIIndex
showMSIPath iMSIIndex


'Subs
Sub createFolderArray(sStartFolderPath)

Dim fso, oSubFolders, oFolder, oFiles, oFile

Set fso = CreateObject("Scripting.FileSystemObject")
Set oStartFolder = fso.GetFolder(sStartFolderPath)
Set oSubFolders = oStartFolder.SubFolders

For Each oFolder in oSubFolders
Set oFiles = oFolder.Files

For Each oFile in oFiles
if InStr(1,oFile.Name,".MSI",1) > 0 then
oFolderDictionary.Add oFolder.Path, oFile.Name
end if
Next

createFolderArray oFolder.Path
Next

End Sub

function getMSIIndex
Dim i, aPaths, aMSIs, s

aPaths = oFolderDictionary.Keys
aMSIs = oFolderDictionary.Items

for i = 0 To oFolderDictionary.Count-1
s = s & "["& i &"] = " & aPaths(i) & aMSIs(i) & Chr(13) & Chr (10)
Next

MsgBox s
end function

sub showMSIPath(iDictIndex)
Dim aPaths, aMSIs, s

aPaths = oFolderDictionary.Keys
aMSIs = oFolderDictionary.Items

s = "Pfad: " & aPaths(iDictIndex) & Chr(13) & Chr (10) & "MSI-File: " & aMSIs(iDictIndex) & Chr(13) & Chr (10)
MsgBox s
end sub

  • Donnerstag, 15 März 2018

Leave a comment

You are commenting as guest.