amend this routine to use something other than Application.FileSearch

[Lucas Budlong]

I'd like to amend this routine to use something other than
Application.FileSearch.

Any thoughts would be most welcome.

Sub RenameJPGs()

Dim oldname As String
Dim newname As String
Dim fname As String
Dim pname As String
Dim i As Integer
Dim d As Variant
fname = "*.jpg" 'filename
pname = "C:\Documents and settings\user\my documents\pics\" 'folder to
use

With Application.FileSearch
.NewSearch
.LookIn = pname
.SearchSubFolders = False
.Filename = fname 'check to see if any files match the fname
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
d = Format(Date, "dddd")
oldname = .FoundFiles(i)
newname = pname & d & i & ".jpg"
Name oldname As newname
Next
End If
End With


End Sub

 

[Bob Phillips]

Dim oFSO

Sub RenameJPGs()
Const pname As String = _
"C:\Documents and settings\user\my documents\pics\" 'folder to use

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles pName

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Dim oldname As String
Dim newname As String
Dim fname As String
Dim i As Integer
Dim d As Variant

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr

For Each file In Folder.Files
If file.Type = "JPEG Image" Then
i = i + 1
oldname = file.Path
newname = sPath & "\" & Format(Date, "dddd") & i & ".jpg"
Name oldname As newname
End If
Next file

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)