I am new to VBA (and have only a bit of training in java), but assembled this bit of code with the help of other posts here and have hit a wall.
I am trying to write code that will cycle through each file in a folder, testing if each file meets certain criteria. If criteria are met, the file names should be edited, overwriting (or deleting prior) any existing files with the same name. Copies of these newly renamed files should then be copied to a different folder. I believe I'm very close, but my code refuses to cycle through all files and/or crashes Excel when it is run. Help please? :-)
Sub RenameImages()
Const FILEPATH As String = _
"C:\\CurrentPath"
Const NEWPATH As String = _
"C:\\AditionalPath"
Dim strfile As String
Dim freplace As String
Dim fprefix As String
Dim fsuffix As String
Dim propfname As String
Dim FileExistsbol As Boolean
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
strfile = Dir(FILEPATH)
Do While (strfile <> "")
Debug.Print strfile
If Mid$(strfile, 4, 1) = "_" Then
fprefix = Left$(strfile, 3)
fsuffix = Right$(strfile, 5)
freplace = "Page"
propfname = FILEPATH & fprefix & freplace & fsuffix
FileExistsbol = FileExists(propfname)
If FileExistsbol Then
Kill propfname
End If
Name FILEPATH & strfile As propfname
'fso.CopyFile(FILEPATH & propfname, NEWPATH & propfname, True)
End If
strfile = Dir(FILEPATH)
Loop
End Sub
If it's helpful, the file names start as ABC_mm_dd_hh_Page_#.jpg and the goal is to cut them down to ABCPage#.jpg
Thanks SO much!
I think it's a good idea to first collect all of the filenames in an array or collection before starting to process them, particularly if you're going to be renaming them. If you don't there's no guarantee you won't confuse Dir(), leading it to skip files or process the "same" file twice. Also in VBA there's no need to escape backslashes in strings.
Here's an example using a collection:
Sub Tester()
Dim fls, f
Set fls = GetFiles("D:\Analysis\", "*.xls*")
For Each f In fls
Debug.Print f
Next f
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "\" Then path = path & "\"
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function