• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 196
  • Last Modified:

VBScript Moving & Rename files

Hi,

I am running into this problem, we will be likely buying this product from Adlibsoftware, it can convert TIF into PDFs, I have been working on the scripts that control the way that converts the files.

I have a following structure:

OrderID(FOLDER)
  ProductName1(FOLDER)
    TIF1
    TIF2
  ProductName2(FOLDER)
    TIF1
    TIF2
  ProductName3(FOLDER)
    TIF1
    TIF2

Is there a way to loop through the OrderID folder and make the file structure like this:

OrderID(FOLDER)
  ProductName1-TIF1
  ProductName1-TIF2
  ProductName2-TIF1
  ProductName2-TIF2
  ProductName3-TIF1
  ProductName3-TIF2


Thx
0
mcrmg
Asked:
mcrmg
  • 5
  • 4
1 Solution
 
basicinstinctCommented:
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
0
 
basicinstinctCommented:
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).
0
 
mcrmgAuthor Commented:
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
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

 
basicinstinctCommented:
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?
0
 
mcrmgAuthor Commented:
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
0
 
mcrmgAuthor Commented:
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
0
 
basicinstinctCommented:
How about this then:

'START CODE
Option Explicit
Const NO_HIGHER_THAN = 2 'This value determines the highest folder depth
'(relative to the "CurrentFolder" object) the files can be brought
'(otherwise each time the script runs it will bring the files one level higher than before)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim depth: depth = 0
Dim delList()
ReDim delList(0)
Main

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

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   Dim File
   Dim newName
   depth = depth + 1
   For Each SubFolder In SubFolders
      If depth >= NO_HIGHER_THAN Then
            Dim Files: Set Files = SubFolder.Files
            If Files.Count > 0 Then
                  Dim upper: upper = UBound(delList)
                  If delList(upper) <> "" Then
                        ReDim Preserve delList(upper + 1)
                End If
                delList(UBound(delList)) = SubFolder
            End If
            For Each File In Files
                  newName = SubFolder.Name + "-" + File.Name
              File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
            Next
      End If
      CheckFolderNames SubFolder
   Next
   depth = depth - 1
End Sub

Sub DeleteFolders(byval dirList)
      Dim i
      If IsArray(dirList) Then
            For i = LBound(dirList) to UBound(dirList)
                  If fso.FolderExists(dirList(i)) Then
                        fso.DeleteFolder(dirList(i))
                  End If
            Next
      End If
End Sub
'END CODE
0
 
mcrmgAuthor Commented:
Thank you
0
 
basicinstinctCommented:
Woo hoo!  Got there in the end.
You're welcome.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now