الله يعطيك العافيه استاذي الفاضل صحيح كان خطاء في الملفات وهي A001 وA002 والصحيحA0001 وA0002 بالجدول وعملت تصحيح لها
وشوف بالوحده النمطيه لداله من عمل استاذنا ابو ابراهيم تتحسس الملفات بجوار القاعده وهي
Public Function GetFileDirectory(MainPath As Object, Optional FileName As Variant)
Dim OFIL As Scripting.File, OFILS As Scripting.Files
Dim OMFD As Scripting.Folder, OSFD As Scripting.Folder
Static XFileName As String, FilePath '.. Static Declaration reserved value when function recoll
'-- get filename in first time call and reserved value
If Not IsMissing(FileName) Then
XFileName = FileName
End If
'-- loop for subfolders in his parent folder
For Each OSFD In MainPath.SubFolders
Set OMFD = FSO.GetFolder(OSFD.Path)
Set OFILS = OSFD.Files
'-- loop for file in each folder
For Each OFIL In OFILS
If OFIL.Name = XFileName Then
FilePath = OFIL.Path
GoTo TheEnd
End If
Next
'-- Function recoll himself with subfolder
GetFileDirectory OSFD
Next
TheEnd:
'-- Function return filepath if file found
GetFileDirectory = FilePath
End Function
واذا لم تتضح لك الفكره راح ارفق لك مثال مصغر بحيث تضيف منه الصوره وتعرضها ولكن بطريقه غير مشفره
تحياتي يالغالي