VBScript Moving & Rename files

This works for me - you run the script in orderID and it will do the rest.

'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder(".")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   Dim File
   Dim n, newName
   For Each SubFolder In SubFolders
      Dim Files: Set Files = SubFolder.Files
      For Each File In Files
      newName = SubFolder.Name + "-" + File.Name
      if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
            File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
      end if
      Next
   Next
End Sub
'END CODE

By the way, just copy the code from 'START CODE to 'END CODE, paste it into an empty text file, save it as 'moveTif.vbs' (or whatever) and run it from the root directory (in this case OrderID).

hi,


It works great..Is it possible that it could be used in this way?

Instead of using . as current folder, can enterence folder be two levels up?

INPUT
***HERE***
   Company

      OrderID(FOLDER)
            ***current enterence folder***
              ProductName1(FOLDER)
                TIF1
                TIF2
              ProductName2(FOLDER)
                TIF1
                TIF2
              ProductName3(FOLDER)
                TIF1
                TIF2


I am sorry that I shouldve mentioned it....thx

Yeah, probably the best idea is just to use an absolute path - then you can run the script from anywhere on the machine's file system.

Instead of using . as current folder use "c:\whatever\Company\OrderID"  So the relevant line will now look like this:

Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("c:\whatever\Company\OrderID")

Does that do the job for you?

This is what I did, but does not seem working....


'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("C:\Input")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   
   Dim SubFolders1: Set SubFolders1 = Folder.SubFolders
   Dim SubFolder1
   
   Dim SubFolders2: Set SubFolders2 = Folder.SubFolders
   Dim SubFolder2
   
   Dim SubFolders3: Set SubFolders3 = Folder.SubFolders
   Dim SubFolder3
           
   Dim File
   Dim n, newName
   For Each SubFolder1 In SubFolders1
               For Each SubFolder2 In SubFolders2
                     For Each SubFolder3 In SubFolders3
               
                           For Each SubFolder In SubFolders
                              Dim Files: Set Files = SubFolder.Files
                              For Each File In Files
                             newName = SubFolder.Name + "-" + File.Name
                             'if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
                                  File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
                             'end if
                              Next
                              'fso.DeleteFolder SubFolder.Name
                           Next
                           
                  Next
            Next
      Next                          
End Sub
'END CODE

okay, it is working now, however, I need to delete those empty folders, it says "path not found"

This line:
fso.DeleteFolder SubFolder2.Name


thx


'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("C:\Input")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
 
   
   
           
   Dim File
   Dim n, newName
   For Each SubFolder In SubFolders
      Dim SubFolders1: Set SubFolders1 = SubFolder.SubFolders
      Dim SubFolder1
               For Each SubFolder1 In SubFolders1
               Dim SubFolders2: Set SubFolders2 = SubFolder1.SubFolders
               Dim SubFolder2
                     For Each SubFolder2 In SubFolders2
                              Dim Files: Set Files = SubFolder2.Files
                              For Each File In Files
                             newName = SubFolder2.Name + "-" + File.Name
                             'if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
                                  File.Move fso.GetParentFolderName(SubFolder2) & "\" & newName
                             'end if
                              Next
                              MsgBox SubFolder2.Name
                              fso.DeleteFolder SubFolder2.Name
                  Next
            Next
      Next                          
End Sub
'END CODE

Thank you

Woo hoo!  Got there in the end.
You're welcome.