Link to home
Start Free TrialLog in
Avatar of paul_at_work
paul_at_work

asked on

Create VB script to rename files based on folder name

Hi, im hoping someone might be able to help.

We have a piece of software that outputs a sequence of files into a newly created folder. for example:
on running the software it would create:
c:\root\Namefolder001\
file1.ext
file2.ext
file3.ext
...
file10.ext
file11.ext
etc
c:\root\Namefolder002\
file1.ext
file2.ext
etc

I would like a VB express 2005 code  that when run would rename the files inside the folder based on the folder name, and also add zeros to the number to ensure it lists correctly. so in example above new files created would become
Namefolder001-001.ext
Namefolder001-002.ext
Namefolder001-003.ext
etc

I would need to process this on multiple on all folders contained in the root folder.

I have already had a solution from another expert (RobSampson) to do this which works outside of VB express, but i am unable to use it inside vb express, so im either after a new solution or the code below modifed to work in VB express.

Cheers
Paul

'==================
strStartFolder = "C:\TEMP\Temp\Test script\Test"
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
For Each objSubFolder In objFSO.GetFolder(strStartFolder).SubFolders
      RecurseFolders objSubFolder
Next
 
MsgBox "Done"
 
Sub RecurseFolders(objFolder)
      For Each objFile In objFolder.Files
            ' Go from the end of the base file name to the start to find how many numbers there are
            intNumberStart = 0
            For intPos = Len(objFSO.GetBaseName(objFile.Path)) To 1 Step -1
                  If IsNumeric(Mid(objFSO.GetBaseName(objFile.Path), intPos, 1)) Then intNumberStart = intPos
            Next
            If intNumberStart > 0 Then
                  objFile.Name = objFSO.GetFolder(objFSO.GetParentFolderName(objFile.Path)).Name & "-" & Right("000" & Mid(objFSO.GetBaseName(objFile.Path), intNumberStart), 3) & "." & objFSO.GetExtensionName(objFile.Path)
            Else
                  MsgBox objFile.Path & " does not have any number sequence."
            End If
      Next
 
      For Each objSubFolder In objFolder.SubFolders
            RecurseFolders objSubFolder
      Next
End Sub
'==================

Open in new window

Avatar of Rog D
Here is a start....

I don't have a lot of time to write the whole thing.

Search google for VB.Net file system and you should be able to fill in the blanks.

Rog
Imports System.IO
Public Class Form1
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
    End Sub
 
 
    Public Sub a()
        '==================
        Dim strStartFolder As String = "C:\TEMP\Temp\Test script\Test"
        Dim objFSO As Object = CreateObject("Scripting.FileSystemObject")
        Dim objSubFolder As IO.DirectoryInfo
        For Each objSubFolder In objFSO.GetFolder(strStartFolder).SubFolders
            RecurseFolders(objSubFolder)
        Next
        MsgBox("Done")
    End Sub
 
    Sub RecurseFolders(ByVal objFolder)
        Dim objfile As IO.File
        Dim intNumberStart As Integer = 0
        Dim intPos As Integer
        Dim objfso As IO.File
        For Each objFile In objFolder.Files
            ' Go from the end of the base file name to the start to find how many numbers there are
            intNumberStart = 0
            For intPos = Len(Path.GetDirectoryName(objfile.Path)) To 1 Step -1
                If IsNumeric(Mid(Path.GetDirectoryName(objfile.Path), intPos, 1)) Then intNumberStart = intPos
            Next
            If intNumberStart > 0 Then
 
                objfile.Name = objfso.GetFolder(objfso.GetParentFolderName(objfile.Path)).Name & "-" & Right("000" & Mid(objfso.GetBaseName(objfile.Path), intNumberStart), 3) & "." & objfso.GetExtensionName(objfile.Path)
            Else
                MsgBox(objfile.Path & " does not have any number sequence.")
            End If
        Next
 
        For Each objSubFolder In objFolder.SubFolders
            RecurseFolders(objSubFolder)
        Next
    End Sub
    '==================
 
End Class

Open in new window

Avatar of paul_at_work
paul_at_work

ASKER

Hi oleggold, - i had already read through that article and it doesnt appear to be for visual basic. I was specifically after something that works in visual basic.

Hi Rog,
thanks for the code, i pasted it into visual basic and there are a few errors that came up. Im learning visual basic as i go (only started 3 days ago!) - so i hope you may be able to point me in the right direction so that i can make use of the script. errors include:
Path is not a member of system.IO.file
GetFolder is not a member of system.IO.file
Getparentfoldername is not a member of system.IO.file

there are more, but if you let me know whats wrong with those I should be able to correct the rest.

cheers
Paul.
Ok...
Here you go...

Please test this.

Right now I use the move command to "Rename" the file.    But this should do what you were asking.

it has not been fully tested that will be up to you.

Also it is a good idea to become familiar with all the objects used here so when you need to make changes you can do this on your own.

Rog
    Sub Main2()
        Dim fileName As String
        fileName = "C:\TEMP\Temp\Test script\Test"
        Dim directoryList As String() ' array for directories
        Dim i As Integer
        directoryList = Directory.GetDirectories(fileName)
        ' output directoryList contents
        For i = 0 To directoryList.Length - 1
            RecurseFolders(directoryList(i))
        Next
    End Sub ' Main
 
    Sub RecurseFolders(ByVal objFolder As String)
        Dim objfile As String
        Dim intNumberStart As Integer = 0
        Dim intPos As Integer
        Dim objfileinfo As IO.FileInfo
        Dim sNewFileName As String
 
        For Each objfile In Directory.GetFiles(objFolder)
            sNewFileName = ""
            objfileinfo = New FileInfo(objfile)
            '    ' Go from the end of the base file name to the start to find how many numbers there are
            intNumberStart = 0
            For intPos = Len(Path.GetDirectoryName(objfile)) To 1 Step -1
                If IsNumeric(Mid(objfile, intPos, 1)) Then intNumberStart = intPos
            Next
            If intNumberStart > 0 Then
                sNewFileName = objfileinfo.Directory.Name & "-000" & objfileinfo.Name
                IO.File.Move(objfile, objfileinfo.DirectoryName & "\" & sNewFileName)
                'objfile = objfso.GetFolder(objfso.GetParentFolderName(objfile.Path)).Name & "-" & Right("000" & Mid(objfso.GetBaseName(objfile.Path), intNumberStart), 3) & "." & objfso.GetExtensionName(objfile.Path)
            Else
                MsgBox(objfile & " does not have any number sequence.")
            End If
        Next
        Dim i As Integer
        Dim directorylist = Directory.GetDirectories(objFolder)
        For i = 0 To directorylist.Length - 1
            RecurseFolders(directorylist(i))
        Next
    End Sub

Open in new window

Hi Rog

thanks for the modified code which now does run in visual basic, however its not working as expected.

It does read the folder names inside the root folder, and it does then rename the files inside those folders- but the renaming is incorrect.

For example the original folder name is
SEQ-001
-file1.jpg
-file2.jpg
-file3.jpg

After running it does the following:
SEQ-001
SEQ-001-000SEQ-001-000SEQ-001-000file1.jpg
SEQ-001-000SEQ-001-000SEQ-001-000file2.jpg
SEQ-001-000SEQ-001-000SEQ-001-000file3.jpg

So its actually renaming the file with the folder name 3 times and adding the existing filename to the end. And it isnt increasing the frame number.

I will try and understand the code to see if I can fix, but if you can spot anything obvious I would appreciate it.

cheers
Paul.
Paul,

Here you go... Fixed code....

Good Luck.  Issue was with the move command.  It should have been a copy then delete of the old.  There doesn't seem to be a rename command.

My bad.

Roger
Sub RecurseFolders(ByVal objFolder As String)
        Dim objfile As String
        Dim intNumberStart As Integer = 0
        Dim intPos As Integer
        Dim objfileinfo As IO.FileInfo
        Dim sNewFileName As String
        For Each objfile In Directory.GetFiles(objFolder)
            sNewFileName = ""
            objfileinfo = New FileInfo(objfile)
            '    ' Go from the end of the base file name to the start to find how many numbers there are
            intNumberStart = 0
            For intPos = Len(objfileinfo.Name) To 1 Step -1
                If IsNumeric(Mid(objfileinfo.Name, intPos, 1)) Then intNumberStart = intPos
            Next
            If intNumberStart > 0 Then
                sNewFileName = objfileinfo.Directory.Name & "-000" & objfileinfo.Name
                IO.File.Copy(objfile, objfileinfo.DirectoryName & "\" & sNewFileName)
                IO.File.Delete(objfile)
                'objfile = objfso.GetFolder(objfso.GetParentFolderName(objfile.Path)).Name & "-" & Right("000" & Mid(objfso.GetBaseName(objfile.Path), intNumberStart), 3) & "." & objfso.GetExtensionName(objfile.Path)
            Else
                MsgBox(objfile & " does not have any number sequence.")
            End If
        Next
        Dim i As Integer
        Dim directorylist = Directory.GetDirectories(objFolder)
        For i = 0 To directorylist.Length - 1
            RecurseFolders(directorylist(i))
        Next
    End Sub

Open in new window

HI Rog,

thanks for the mod, although its still not working as hoped.
it is renaming the existing file to a new name based on the folder name, but is also appending the original file name.

so if folder is called SEQ-001 and file inside this called file1.jpg the newly created file becomes
SEQ-001-000file1.jpg
but it should rename it to
SEQ-001-001.jpg

It should  remove the original filename completely but append the file number.
for example
SEQ-001
file1.jpg
file2.jpg
file3.jpg

would become
SEQ-001
SEQ-001-001.jpg
SEQ-001-002.jpg
SEQ-001-003.jpg

Sorry its taking a while to resolve.

cheers
Paul.
ASKER CERTIFIED SOLUTION
Avatar of Rog D
Rog D
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Hi Rog,

Thats brilliant thanks!!! a well deserved 50.00!! (or 500 points anyway!!)

Thanks for spending your time on that. I will try and spend some time understanding how the code works.

CHeers
Paul.
many thanks