Jump to content

Recommended Posts

Posted

Hi all

I have used this script but it doesnt work - any ideas?

Dim FSO

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO = "bodykit0.txt" Then

FSO.MoveFile "C:\Users\Lisa\desktop\bodykit0.txt", "C:\Users\Lisa\desktop\bodykitblack.txt"

Endif

If FSO = "bodykit1.txt" Then

FSO.MoveFile "C:\Users\Lisa\desktop\bodykit1.txt", "C:\Users\Lisa\desktop\bodykitwhite.txt"

Endif

Set FSO = nothing

I'm trying to look through a list of files and rename them based on their original name, there will be a number of files in the folder (it wont be my desktop ofc) and I want to rename them based on their number, so 0=black, 1=white etc etc... Any help GREATLY appreciated!!


Posted

The only thing you had wrong was you If statements

If FSO = "bodykit0.txt" Then
FSO.MoveFile "C:\Users\Lisa\desktop\bodykit0.txt", "C:\Users\Lisa\desktop\bodykitblack.txt"
Endif

 Dim FSO 
Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FileExists("bodykit0.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\bodykit0.txt", "C:\Users\Lisa\desktop\bodykitblack.txt"
End If

If FSO.FileExists("bodykit1.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\bodykit1.txt", "C:\Users\Lisa\desktop\bodykitwhite.txt"
End If

Posted

Sorry, new to the forum, after i posted in a reply i worked out how to post it as a new one.

Thanks - gonna try now :)

Ok... maybe a silly question but.. how does it know where to look for the file? I tell it where to rename a file, but when you look for the file existing dont I need to somehow tell it where to look?

Posted

The script takes the current directory as the start point.

So if you are running the script and there are no files

then the files dont exists in that location.

Try this script, I have it produce a text file, see if it does what you want.

 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
'-> "." Makes The Folder Where The Script Located The Parent Folder, You Can Add Full Path
Dim Dir :Set Dir = Fso.GetFolder(".")
'-> Varibles For Text Output
Dim Lne, Ts, Txt
Txt = Fso.GetAbsolutePathName(".") & "\DirListResults.txt"
Lne = "--------------------------------------------------------------------------------"
Set Ts = Fso.CreateTextFile(Txt)
Ts.WriteLine "Scan Time : " & Time
'-> Start Looping Threw The Folder Sub Folder
Recursive Fso.GetFolder(Dir)
Function Recursive(Folder)
Dim Col :Set Col = Folder.files
Dim Chk1, File
For Each File In Col
Chk1 = Right(File.Name,5)
If InStr(Chk1,"0") Or _
InStr(Chk1,"1") Or _
InStr(Chk1,"2") Or _
InStr(Chk1,"3") Or _
InStr(Chk1,"4") Or _
InStr(Chk1,"5") Or _
InStr(Chk1,"6") Or _
InStr(Chk1,"7") Or _
InStr(Chk1,"8") Or _
InStr(Chk1,"9") Then
'-> Move Cmd Here
Ts.WriteLine "Confirm File : " & File.Path
End If
Next
Dim Obj
For Each Obj In Folder.subFolders
Recursive Obj
Next
End Function
Ts.Close
CreateObject("Wscript.Shell").Run("Notepad " & Chr(34) & Txt & Chr(34)),1,True

Posted

Brilliant thanks :-) this was along the lines but I simplified it in the end and use the script from the desitnation folder instead.

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists("x_bodykit_SAP_0000.txt") Then
FSO.movefile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0000.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Arctic_White.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0001.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0001.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Brilliant_Black.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0003.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0002.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_True_Red.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0003.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0003.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Aluminium_Metallic.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0004.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0004.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Aurora_Blue_Mica.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0005.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0005.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Celestial_Blue_Mica.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0006.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0006.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Clear_Water_Blue_Metallic.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0007.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0007.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Copper_Red_Mica.txt"
End if
If FSO.FileExists("x_bodykit_SAP_0008.txt") Then
FSO.MoveFile "C:\Users\Lisa\desktop\colours\x_bodykit_SAP_0008.txt", "C:\Users\Lisa\desktop\colours\x_bodykit_Crystal_White_Pearl_Mica.txt"
End if


Set FSO = nothing

However, what if I now want to make it a bit more complicated? Lets say my original file name is Bed_0001 or could be table_0001 etc etc, it will always have the 4 digit number but the text in it could change depending on the file being saved. Now I would like my script to look at the original name and only see what the 4 digit number is to decide what to rename it

So basically I figure I have to have the original name as a string and to search for the digits in it? How do you think I should do this? Any help greatly appreciated :)

Posted

In your script you should make a varible for this path C:\Users\Lisa\desktop\colours, I also

change all the If End If

Dim FSO :Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Loc :Loc = "C:\Users\Lisa\desktop\colours"

If FSO.FileExists("x_bodykit_SAP_0000.txt") Then
FSO.movefile Loc & "\x_bodykit_SAP_0000.txt", Loc & "\x_bodykit_Arctic_White.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0001.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0001.txt", Loc & "x_bodykit_Brilliant_Black.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0003.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0002.txt", Loc & "\x_bodykit_True_Red.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0003.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0003.txt", Loc & "\x_bodykit_Aluminium_Metallic.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0004.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0004.txt", Loc & "\x_bodykit_Aurora_Blue_Mica.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0005.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0005.txt", Loc & "\x_bodykit_Celestial_Blue_Mica.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0006.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0006.txt", Loc & "\x_bodykit_Clear_Water_Blue_Metallic.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0007.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0007.txt", Loc & "\x_bodykit_Copper_Red_Mica.txt"
ElseIf FSO.FileExists("x_bodykit_SAP_0008.txt") Then
FSO.MoveFile Loc & "\x_bodykit_SAP_0008.txt", Loc & "\x_bodykit_Crystal_White_Pearl_Mica.txt"
End if

Posted

Do you mean something like this

Example from first script posted

	 Chk1 =  Right(File.Name,5)
If InStr(Chk1,"0") Or _
InStr(Chk1,"1") Or _
InStr(Chk1,"2") Or _
InStr(Chk1,"3") Or _
InStr(Chk1,"4") Or _
InStr(Chk1,"5") Or _
InStr(Chk1,"6") Or _
InStr(Chk1,"7") Or _
InStr(Chk1,"8") Or _
InStr(Chk1,"9") Then

1:\ Is the script going to be in the same path as the files

EG C:\Users\Lisa\desktop\colours\YOUR_VBS_SCRIPT

If yes then you can use a line of code like this to get the path

Dim Dir :Set Dir = FSO.GetFolder(".")

Try this script it uses copy then delete. I used this in case the file that was

getting moved existed this will causes a error to occur. Using the copy and

setting the switch to true means to copy and over write the file.

 Dim FSO :Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Dir :Set Dir = FSO.GetFolder(".")
Dim Chk, Obj, Str, Var
For Each Obj In Dir.Files
Chk = Right(Obj.Name,8)
Str = Split(Chk,".")
If Str(0) = "0000" Then
Var = Dir.Path & "\x_bodykit_Arctic_White.txt"
ChangeName()
ElseIf Str(0) = "0001" Then
Var = Dir.Path & "\x_bodykit_Brilliant_Black.txt"
ChangeName()
ElseIf Str(0) = "0002" Then
Var = Dir.Path & "\x_bodykit_True_Red.txt"
ChangeName()
ElseIf Str(0) = "0003" Then
Var = Dir.Path & "\x_bodykit_Aluminium_Metallic.txt"
ChangeName()
ElseIf Str(0) = "0004" Then
Var = Dir.Path & "\x_bodykit_Aurora_Blue_Mica.txt"
ChangeName()
ElseIf Str(0) = "0005" Then
Var = Dir.Path & "\x_bodykit_Celestial_Blue_Mica.txt"
ChangeName()
ElseIf Str(0) = "0006" Then
Var = Dir.Path & "\x_bodykit_Clear_Water_Blue_Metallic.txt"
ChangeName()
ElseIf Str(0) = "0007" Then
Var = Dir.Path & "\x_bodykit_Copper_Red_Mica.txt"
ChangeName()
ElseIf Str(0) = "0008" Then
Var = Dir.Path & "\x_bodykit_Crystal_White_Pearl_Mica.txt"
ChangeName()
ElseIf Str(0) = "0009" Then
Var = Dir.Path & "\CHANGE_THIS.txt"
ChangeName()
End If
Next
Function ChangeName()
FSO.CopyFile Obj.Path, Var, True
FSO.DeleteFile(Obj.Path),True
End Function

Posted

Last question i promise :-) but now you have me on a roll!

What if I now wanted to just replace the number 0000 with Arctic_White for example and keep the rest of the original filename the same?

So if its bodykit_0000 or bed_0000 it would rename it to be bodykit_arctic_white or bed_arctic_white etc etc

So to find the number and replace only the number in the string??

Posted

Try this

 Dim FSO :Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Dir :Set Dir = FSO.GetFolder(".")
Dim Chk, Obj, Str, Var
For Each Obj In Dir.Files
Chk = Right(Obj.Name,8)
Str = Split(Chk,".")
If Str(0) = "0000" Then
Var = Replace(Obj.Path,Str(0),"Arctic_White")
ChangeName()
ElseIf Str(0) = "0001" Then
Var = Replace(Obj.Path,Str(0),"Brilliant_Black")
ChangeName()
ElseIf Str(0) = "0002" Then
Var = Replace(Obj.Path,Str(0),"True_Red")
ChangeName()
ElseIf Str(0) = "0003" Then
Var = Replace(Obj.Path,Str(0),"Aluminium_Metallic")
ChangeName()
ElseIf Str(0) = "0004" Then
Var = Replace(Obj.Path,Str(0),"Aurora_Blue_Mica")
ChangeName()
ElseIf Str(0) = "0005" Then
Var = Replace(Obj.Path,Str(0),"Celestial_Blue_Mica")
ChangeName()
ElseIf Str(0) = "0006" Then
Var = Replace(Obj.Path,Str(0),"Clear_Water_Blue_Metallic")
ChangeName()
ElseIf Str(0) = "0007" Then
Var = Replace(Obj.Path,Str(0),"Copper_Red_Mica")
ChangeName()
ElseIf Str(0) = "0008" Then
Var = Replace(Obj.Path,Str(0),"Crystal_White_Pearl_Mica")
ChangeName()
ElseIf Str(0) = "0009" Then
Var = Replace(Obj.Path,Str(0),"CHANGE_THIS")
ChangeName()
End If
Next
Function ChangeName()
FSO.CopyFile Obj.Path, Var, True
FSO.DeleteFile(Obj.Path),True
End Function

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...