Solved: renaming files using excel

[XLGibbs]

Here ya go...made a few changes to resolve some of the issue you mentioned. Right now it is looking for all files...

because of this:

.FileType = msoFileTypeAllFiles

which be changed to

.FileName = "*.jpg"

for example to find only .jpg files


[VBA]
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
ToggleStuff True
Exit Function

Invalid:
MsgBox "Invalid Path, retry"

ToggleStuff True

End Function

Sub PopulateDirectoryList(ByVal rngDir As Range)

Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long
Dim strPath As String, strFile As String, pos

ToggleStuff False

Set objFSO = New FileSystemObject 'set a new object in memory
strSourceFolder = BrowseForFolder

With Application.FileSearch
.LookIn = strSourceFolder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute

For x = 1 To .FoundFiles.Count
'set incidental variables
On Error GoTo Skip
pos = InStrRev(.FoundFiles(x), "\")
strFile = Right(.FoundFiles(x), Len(.FoundFiles(x)) - pos)
strPath = Left(.FoundFiles(x), pos)

rngDir.Offset(x, 0) = strPath
rngDir.Offset(x, 1) = strFile

Skip:
'this is in case a Permission denied error comes up or something.
Next x

End With

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

ToggleStuff True
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub

Sub RenameUs()

Dim objFSO As FileSystemObject, c As Range
Dim strSourceFolder As String
Dim rngFileList As Range

Set objFSO = New FileSystemObject 'set a new object in memory

ToggleStuff False
With ActiveSheet

Set rngFileList = Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

For Each c In rngFileList

If c.Offset(, 2) <> "" Then 'if the rename is empty move on
strFileName = c.Offset(, 1) 'set the file name, column B
strSourceFolder = c 'set the folder name, columnB
strRename = c.Offset(, 2)

'copy file with new name
On Error GoTo Skip
objFSO.CopyFile strSourceFolder & "\" & strFileName, strSourceFolder & "\" & strRename, True
objFSO.DeleteFile (strSourceFolder & "\" & strFileName)

c.Offset(, 3) = "Renamed"
Else:
Skip:
c.Offset(, 3) = "Skipped"
End If


Next c
End With

Set objFSO = Nothing: Set rngFileList = Nothing

ToggleStuff True
End Sub

Sub ClearList()

With ActiveSheet
.Range("A2" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

End Sub
[/vba]