Expert: Tom Ogilvy - 7/9/2009

Question
QUESTION: I have the following code that I wrote in Excel 2003:


Sub Generate_Drawing()
If Sheet10.Range("AN50") = "Drawing Available" Then _

   If Range("AG57").Value = "Your drawing is ready to be generated" Then
   Sheet10.Unprotect Password:="$$$"
   Dim s As String, i As Integer, d As Object
   s = "C:\Images"
   Sheet10.Range("C4").Select
     For Each d In Sheet10.DrawingObjects
      If d.TopLeftCell.Address = "$C$4" Then
         d.Delete
     End If
      Next
   With Application.FileSearch
   .NewSearch
   .LookIn = s
   .SearchSubFolders = True
   .Filename = "*" & Sheet10.Range("E56") & ".EMF"
   .Execute
   For i = 1 To .FoundFiles.Count
   Sheet10.Pictures.Insert (.FoundFiles(i))
  Exit For
  Next i
  End With
  Else
  End If
Sheet10.Protect Password:="$$$"
Else
If Sheet10.Range("AN50") = "Drawing Not Available" Then _
Ans = MsgBox("Drawing Not Available", vbCritical)
End If
End Sub


This Macro basically looks for a file name in cell E56 and and searches for that file in C:\Images and then pastes that image into cell C4. The Problem is when I run this in excel 2007, the line 'With Application.FileSearch' is highlighted as an error and the code does not work. I've seen that this application has been removed from 2007. How can I modify this code so that it works the same way in 2007 as it does in 2003? Thanks so much if you can help me out.

ANSWER: Melo,

this article explains what you have said and has a link to Microsoft's recommended solution using the scripting runtime or scripting windows search:

http://support.microsoft.com/kb/920229
Error message when you run a macro to search for a file in an Office 2007 program: "Run-time error 5111"


This article also addresses searching directories and subdirectories.
(just provided as an additional source of information).
http://support.microsoft.com/kb/185601/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

QUESTION: Thanks for the link. I've tried implementing code using the 'recursively search directories' sample, but am unable to do what I am trying to do, as I am very new to VBA. The sample is far different than what I am trying to achieve. If you could give me some advice on how to modify that code it would really be appreciated. Thanks alot for your help.

ANSWER: Melo,

first, go into the Visual Basic Editor (VBE) and make your project the active project by selecting it in the Project Explorer Window.  

then go to Tools=>References in the menu in the VBE and scroll through the list of references until you find the Microsoft Scripting Runtime.  Click the checkbox next to it so it is selected.  

Now,

Insert a new module and paste this code in (read this response at the allexperts site and copy it from there to avoid word wrap problems in email).   

Option Explicit

Dim fso As New FileSystemObject
Dim fld As Folder

Sub Generate_Drawing()
Dim ans As Long
If Sheet10.Range("AN50") = "Drawing Available" Then _

  If Range("AG57").Value = "Your drawing is ready to be generated" Then
  Sheet10.Unprotect Password:="$$$"
  Dim s As String, i As Integer, d As Object, v As Variant
  Dim sName As String
  ReDim v(1 To 100)
  s = "C:\Images"
  Sheet10.Range("C4").Select
    For Each d In Sheet10.DrawingObjects
     If d.TopLeftCell.Address = "$C$4" Then
         d.Delete
    End If
     Next
  sName = "*" & Sheet10.Range("E56") & ".EMF"
  Findfiles s, sName
  If Len(Trim(v(1))) > 0 Then
    For i = 1 To 100
      Sheet10.Pictures.Insert v(i)
      Exit For
    Next i
   Else
     MsgBox s & "\" & sName & " not found"
   End If
  End If
 Sheet10.Protect Password:="$$$"
Else
 If Sheet10.Range("AN50") = "Drawing Not Available" Then _
   ans = MsgBox("Drawing Not Available", vbCritical)
End If
End Sub



Public Sub Findfiles(s As String, sName As String)
  Dim nDirs As Long, nFiles As Long, lSize As Currency
  Dim sDir As String, sSrchString As String
  
  ReDim v(1 To 500)
  sDir = s
  sSrchString = sName


  lSize = FindFile(sDir, sSrchString, nDirs, nFiles, v)

End Sub

Public Function FindFile(ByVal sFol As String, sFile As String, _
  nDirs As Long, nFiles As Long, v As Variant) As Currency
  Dim tFld As Folder, tFil As File, FileName As String
  
  On Error GoTo Catch
  Set fld = fso.GetFolder(sFol)
  FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
         vbHidden Or vbSystem Or vbReadOnly)
  While Len(FileName) <> 0
     FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, _
     FileName))
     nFiles = nFiles + 1
  '   List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
     v(nFiles) = fso.BuildPath(fld.Path, FileName)
     FileName = Dir()  ' Get next file
     DoEvents
  Wend
 
  nDirs = nDirs + 1
  If fld.SubFolders.Count > 0 Then
     For Each tFld In fld.SubFolders
        DoEvents
        FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, v)
     Next
  End If
  Exit Function
Catch:  FileName = ""
      Resume Next
End Function

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Thanks so much for your help, the macro does run. However, it doesn't seem to be pulling in any files. A msgbox always appears saying 'C:\Images\Drawing(or whatever the file is called).EMF not found' . Is it reading the directory C:\Images as part of the file name as opposed to just the Drawing.EMF part? I've checked to make sure the file name in E56 is the same as the file name in C:\Images so that doesn't seem to be the problem. Any ideas why this isn't pulling in the picture? I truly apologize for taking so much of your time. Thank you very much sir.

Answer
Melo,
Try this version.  Since I can't test with your code, I am at a disadvantage.  

Option Explicit

Dim fso As New FileSystemObject
Dim fld As Folder

Sub Generate_Drawing()
Dim ans As Long
If Sheet10.Range("AN50") = "Drawing Available" Then _

 If Range("AG57").Value = "Your drawing is ready to be generated" Then
 Sheet10.Unprotect Password:="$$$"
 Dim s As String, i As Integer, d As Object, v As Variant
 Dim sName As String
 ReDim v(1 To 100)
 s = "C:\Images"
 Sheet10.Range("C4").Select
   For Each d In Sheet10.DrawingObjects
    If d.TopLeftCell.Address = "$C$4" Then
        d.Delete
   End If
    Next
 sName = "*" & Sheet10.Range("E56") & ".EMF"
 Findfiles s, sName, v
 If Len(Trim(v(1))) > 0 Then
   For i = 1 To 100
     Sheet10.Pictures.Insert v(i)
     Exit For
   Next i
  Else
    MsgBox s & "\" & sName & " not found"
  End If
 End If
Sheet10.Protect Password:="$$$"
Else
If Sheet10.Range("AN50") = "Drawing Not Available" Then _
  ans = MsgBox("Drawing Not Available", vbCritical)
End If
End Sub



Public Sub Findfiles(s As String, sName As String, v As Variant)
 Dim nDirs As Long, nFiles As Long, lSize As Currency
 Dim sDir As String, sSrchString As String
 

 sDir = s
 sSrchString = sName


 lSize = FindFile(sDir, sSrchString, nDirs, nFiles, v)

End Sub

Public Function FindFile(ByVal sFol As String, sFile As String, _
 nDirs As Long, nFiles As Long, v As Variant) As Currency
 Dim tFld As Folder, tFil As File, FileName As String
 
 On Error GoTo Catch
 Set fld = fso.GetFolder(sFol)
 FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
         vbHidden Or vbSystem Or vbReadOnly)
 While Len(FileName) <> 0
    FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, _
    FileName))
    nFiles = nFiles + 1
 '   List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
    v(nFiles) = fso.BuildPath(fld.Path, FileName)
    FileName = Dir()  ' Get next file
    DoEvents
 Wend

 nDirs = nDirs + 1
 If fld.SubFolders.Count > 0 Then
    For Each tFld In fld.SubFolders
       DoEvents
       FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, v)
    Next
 End If
 Exit Function
Catch:  FileName = ""
     Resume Next
End Function

--
Regards,
Tom Ogilvy