Filesearch recursive
Mit freundlicher Erlaubnis eines Kollegen.
'global DimsDim oFolderDictionary, iMSIIndex, sStartFolderSet oFolderDictionary = CreateObject("Scripting.Dictionary")'ConfigurationsStartFolder = "M:\2_Paketierung\_Http_Frnk"'Main ProgramcreateFolderArray sStartFolderiMSIIndex = getMSIIndexshowMSIPath iMSIIndex'SubsSub 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 NextEnd Subfunction 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 send functionsub 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 send sub