Ik heb ooit een Excel gemaakt of verbasteld van een ander lid die scripts kom maken. Was wel handig. Nu is het probleem dat er een oude code in zit, Application.FileSearch, die niet meer ondersteund wordt. Kan iemand mij hierbij helpen. Ik zou niet weten hoe je dit moet herschrijven.
Muchias gracias
Een (zeer snelle) scan door de code doet me denken dat je wat hebt aan de Dir() functie
Hans,
Check bijgaande link
http://www.mrexcel.com/forum/excel-questions/268046-application-filesearch-gone-excel-2007-alternatives.html (http://www.mrexcel.com/forum/excel-questions/268046-application-filesearch-gone-excel-2007-alternatives.html)
Zie net dat die link alleen maar dode links oplevert. Ga even verder voor je kijken
edit: Zie bijgande link
http://www.vbaexpress.com/forum/archive/index.php/t-35129.html (http://www.vbaexpress.com/forum/archive/index.php/t-35129.html)
Hier staat hoe je het kan doen met het FSO object.
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemobject")
Call ProcessFolder(FSO, "C:\test", LookingFor, ThisBook)
Set FSO = Nothing
End Sub
Private Function ProcessFolder( _
ByRef FSO As Object, _
ByVal Foldername As String, _
ByVal LookingFor As String, _
ByRef ThisBook As Workbook)
Dim fldr As Object
Dim subFldr As Object
Dim file As Object
Dim cell As Range
Dim FirstAddress As String
Dim i As Long
Set fldr = FSO.GetFolder(Foldername)
For Each subFldr In fldr.SubFolders
Call ProcessFolder(FSO, subFldr.Path, LookingFor, ThisBook)
Next subFldr
For Each file In fldr.Files
Application.Workbooks.Open file.Path
'search all the sheets in the current book
For i = 1 To Sheets.Count
With Sheets(i).Range("A1:D500")
Set cell = .Find(LookingFor, LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=False)
If cell Is Nothing Then '<< there's nothing on this sheet
GoTo Finish2
Else
FirstAddress = cell.Address '<< (bookmark)
Do
'add this item to the search results
ThisBook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = ActiveWorkbook.Name
ThisBook.Sheets(1).Range("B65536").End(xlUp).Offset(1, 0) = Sheets(i).Name
ThisBook.Sheets(1).Range("C65536").End(xlUp).Offset(1, 0) = cell.Address
ThisBook.Sheets(1).Range("D65536").End(xlUp).Offset(1, 0) = "(" & cell.Value & ")"
'look for any others
Set cell = .FindNext(cell)
Loop Until cell Is Nothing Or cell.Address = FirstAddress
End If
End With
Finish2:
Next i
ActiveWorkbook.Close savechanges:=False
'search finished in current book, search the next book
Next file
Set file = Nothing
Set subFldr = Nothing
Set fldr = Nothing
End Function
Overigens kun je met het FSO object ook makkelijk files schrijven en benaderen, Folders aanmaken enz..
Bij extra--> verwijzingen --> een verwijzigen toevoegen naar Microsoft Scripting Runtime
Hoef je niet met late binding te werken zoals in bovenstaande voorbeeld
groeten stephan
Hans,
Misschien moet je hier ook eens naar kijken
http://adndevblog.typepad.com/autocad/2012/04/batch-purging-of-drawing-files-using-scriptpro-20.html
Hiermee kun je aan batch scripts uit voeren op je tekeningen. Scheelt weer in eigen ontwikkelingen voor het maken van bach scripting files
groeten
stephan
Super! bedankt!