AboutTom Ogilvy Expertise Worked with the program for many years - provided assistance on MS Excel Newsgroups since 1997. Have received the Microsoft MVP award annually since 1999.
I don't answer questions on using Excel in a browser
Since I have no way to test this. Prefer not to answer charting questions. I consider myself to be particularly knowledgeable about using VBA internal to Excel but have no problems with formulas and pivot tables either.
Experience Have Used Excel for 15 - 20 years. Answered in excess of 70,000 Excel related questions in MS Excel newsgroups. Unless obvious, please specify whether you want a worksheet function or macro/VBA solution.
Education/Credentials BS General Engineering (concentration in Industrial Engineering)
MS Operations Research Systems Analysis
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:
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
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
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here
